Skip to content

Commit

Permalink
ogma-core: Replace uses of awhen with uses of for_. Refs #150.
Browse files Browse the repository at this point in the history
The dependency on IfElse is quite unnecessary: it seems like the only
function we use from that library is awhen :: Monad m => Maybe a -> (a
-> m ()) -> m (), which is a type-specialized version of
Data.Foldable.for_.. Since the latter is in base, we can simplify Ogma
by removing the dependency on IfElse.

This commit replaces uses of awhen with uses of for_.
  • Loading branch information
ivanperez-keera committed Sep 22, 2024
1 parent eb2a995 commit 35bc9f9
Show file tree
Hide file tree
Showing 2 changed files with 6 additions and 6 deletions.
4 changes: 2 additions & 2 deletions ogma-core/src/Command/FRETComponentSpec2Copilot.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,9 +41,9 @@ module Command.FRETComponentSpec2Copilot
where

-- External imports
import Control.Monad.IfElse ( awhen )
import Data.Aeson ( eitherDecode, decode )
import Data.ByteString.Lazy (fromStrict)
import Data.Foldable (for_)

-- External imports: auxiliary
import Data.ByteString.Extra as B ( safeReadFile )
Expand Down Expand Up @@ -91,7 +91,7 @@ fretComponentSpec2Copilot fp options = do
let (mOutput, result) =
fretComponentSpec2CopilotResult options fp copilot

awhen mOutput putStrLn
for_ mOutput putStrLn
return result

-- | Print the contents of a Copilot module that implements the Past-time TL
Expand Down
8 changes: 4 additions & 4 deletions ogma-core/src/Command/FRETReqsDB2Copilot.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,9 @@ module Command.FRETReqsDB2Copilot
where

-- External imports
import Control.Monad.IfElse ( awhen )
import Data.Aeson ( eitherDecode )
import Data.List ( nub, (\\) )
import Data.Aeson (eitherDecode)
import Data.Foldable (for_)
import Data.List (nub, (\\))

-- External imports: auxiliary
import Data.ByteString.Extra as B ( safeReadFile )
Expand Down Expand Up @@ -88,7 +88,7 @@ fretReqsDB2Copilot fp options = do
let (mOutput, result) =
fretReqsDB2CopilotResult options fp copilot

awhen mOutput putStrLn
for_ mOutput putStrLn
return result

-- | Print the contents of a Copilot module that implements the Past-time TL
Expand Down

0 comments on commit 35bc9f9

Please sign in to comment.