Reorganize things in preparation for formatting

app/MimaAsm/Main.hs

@@ -33,7 +33,7 @@ main = doRun_ $ do
   settings <- lift $ execParser opts
 
   lift $ putStrLn $ "Loading assembly file at " ++ infile settings
-  (state, _) <- parseFile parseState (infile settings)
+  (state, _) <- loadFile readState (infile settings)
   lift $ putStrLn "Parsing successful"
 
   lift $ putStrLn $ "Writing result to " ++ outfile settings

app/MimaRun/Main.hs

@@ -94,7 +94,7 @@ runMima settings s f =
       pure s'
 
 loadFlagFile :: FilePath -> Run (Flags (MimaAddress -> Bool))
-loadFlagFile filename = flagChecks <$> parseFile parseFlagFile filename
+loadFlagFile filename = (interpretFlagSpec . getFlagSpec) <$> loadFile readFlagFile filename
 
 loadFlags :: Settings -> Run (Flags (MimaAddress -> Bool))
 loadFlags settings = do

src/Mima/Assembler/Parser.hs

@@ -2,6 +2,7 @@
 
 module Mima.Assembler.Parser
   ( parseState
+  , readState
   ) where
 
 import           Control.Monad
@@ -18,6 +19,7 @@ import           Mima.Assembler.Parser.Instruction
 import           Mima.Assembler.Parser.Label
 import           Mima.Assembler.Parser.RawInstruction
 import           Mima.Assembler.Parser.Register
+import           Mima.Parse.Weed
 import           Mima.State
 import           Mima.Word
 
@@ -112,3 +114,6 @@ parseState = do
   let mem = mapToMemory $ Map.map rawInstructionToWord rawInstructions
       labelNames = Map.fromList $ map (\(k, v) -> (lName k, v)) $ Map.toList labels
   pure (stateFromRegisters registers mem, labelNames)
+
+readState :: FilePath -> T.Text -> Either WeedErrorBundle (MimaState, Map.Map T.Text MimaAddress)
+readState filename input = parse parseState filename input

src/Mima/Flag.hs

@@ -15,11 +15,13 @@ module Mima.Flag
   , specNull
   , specContains
   , Flag(..)
-  , allFlags
   , flagChar
   , Flags(..)
   , rawFlags
-  , flagChecks
+  , AllFlags
+  , FlagSpec
+  , getFlagSpec
+  , interpretFlagSpec
   , noFlags
   ) where
 
@@ -78,9 +80,6 @@ specContains as addr = any (`rangeContains` addr) $ specToRanges as
 data Flag = Breakpoint | Executable | ReadOnly
   deriving (Show, Eq, Ord)
 
-allFlags :: [Flag]
-allFlags = [Breakpoint, Executable, ReadOnly]
-
 flagChar :: Flag -> Char
 flagChar Breakpoint = 'b'
 flagChar Executable = 'e'
@@ -114,18 +113,26 @@ rawFlags = Flags
   , flagReadOnly   = ReadOnly
   }
 
-flagChecks :: Map.Map AddressRange (Set.Set Flag) -> Flags (MimaAddress -> Bool)
+type AllFlags = Map.Map AddressRange (Set.Set Char)
-flagChecks m =
+type FlagSpec = Flags AddressSpec
-  let getAddressSpec :: Flag -> AddressSpec
-      getAddressSpec f = rangesToSpec $ map fst $ filter (Set.member f . snd) $ Map.assocs m
 
-      conditions :: Flags (AddressSpec -> MimaAddress -> Bool)
+getFlagSpec :: AllFlags -> FlagSpec
+getFlagSpec af =
+  let isInSet :: Flag -> Set.Set Char -> Bool
+      isInSet f s = flagChar f `Set.member` s
+      getAddressSpec :: Flag -> AddressSpec
+      getAddressSpec f = rangesToSpec $ map fst $ filter (isInSet f . snd) $ Map.assocs af
+  in  pure getAddressSpec <*> rawFlags
+
+interpretFlagSpec :: FlagSpec -> Flags (MimaAddress -> Bool)
+interpretFlagSpec spec =
+  let conditions :: Flags (AddressSpec -> MimaAddress -> Bool)
       conditions = Flags
         { flagBreakpoint = specContains
         , flagExecutable = \as -> if specNull as then const True else specContains as
         , flagReadOnly = specContains
         }
-  in  conditions <*> (getAddressSpec <$> rawFlags)
+  in  conditions <*>  spec
 
 -- | These checks should behave as if no flags were set at all.
 noFlags :: Flags (MimaAddress -> Bool)

src/Mima/IO.hs

@@ -6,7 +6,7 @@ module Mima.IO
   , doRun_
   , tryRun
   , readTextFile
-  , parseFile
+  , loadFile
   ) where
 
 import           Control.Monad.Trans.Class
@@ -16,7 +16,7 @@ import qualified Data.Text.IO as T
 import           System.IO.Error
 import           Text.Megaparsec
 
-import           Mima.Parse.Common
+import           Mima.Parse.Weed
 
 type Run a = ExceptT String IO a
 
@@ -49,9 +49,9 @@ readTextFile filepath = do
       then pure $ Left $ "Can't load file " ++ filepath ++ ": " ++ ioeGetErrorString e
       else ioError e -- This error does not concern us
 
-parseFile :: Parser a -> FilePath -> Run a
+loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a
-parseFile parser filepath = do
+loadFile f filepath = do
   content <- readTextFile filepath
-  case parse parser filepath content of
+  case f filepath content of
-    Right a           -> pure a
     Left errorBundle  -> throwE $ errorBundlePretty errorBundle
+    Right a           -> pure a

src/Mima/Parse/FlagFile.hs

@@ -2,32 +2,29 @@
 
 module Mima.Parse.FlagFile
   ( parseFlagFile
+  , readFlagFile
   ) where
 
 import           Control.Monad
 import           Data.Char
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import           Text.Megaparsec
 
 import           Mima.Flag
 import           Mima.Parse.Common
 import           Mima.Parse.Lexeme
+import           Mima.Parse.Weed
 import           Mima.Word
 
 lAddress :: Parser MimaAddress
 lAddress = lexeme fixedWidthHexAddress
 
-lFlag :: Parser (Set.Set Flag)
+lFlag :: Parser (Set.Set Char)
-lFlag =
+lFlag = lexeme $ label "alphanumeric character" $ Set.singleton <$> satisfy isAlphaNum
-  -- Not sure if there's a better way than writing the fold
-  -- explicitly. Mconcat doesn't seem to do the trick.
-  let knownFlags = foldl (<|>) empty
-                 $ map (\f -> Set.singleton f <$ single (flagChar f)) allFlags
-      otherFlags = label "alphanumeric character" $ Set.empty <$ satisfy isAlphaNum
-  in lexeme $ knownFlags <|> otherFlags
 
-lFlags :: Parser (Set.Set Flag)
+lFlags :: Parser (Set.Set Char)
 lFlags = Set.unions <$> some lFlag
 
 lAddressRange :: Parser AddressRange
@@ -37,7 +34,7 @@ lAddressRange = do
   void $ symbol ":"
   pure $ range firstAddress secondAddress
 
-lLine :: Parser (AddressRange, Set.Set Flag)
+lLine :: Parser (AddressRange, Set.Set Char)
 lLine = do
   a <- lAddressRange
   void $ symbol ":"
@@ -45,5 +42,8 @@ lLine = do
   hidden lNewlines
   pure (a, f)
 
-parseFlagFile :: Parser (Map.Map AddressRange (Set.Set Flag))
+parseFlagFile :: Parser AllFlags
 parseFlagFile = space *> many lNewline *> (Map.fromList <$> many lLine) <* hidden eof
+
+readFlagFile :: FilePath -> T.Text -> Either WeedErrorBundle AllFlags
+readFlagFile filename input = parse parseFlagFile filename input

src/Mima/Parse/SymbolFile.hs

@@ -3,7 +3,7 @@
 module Mima.Parse.SymbolFile
   ( parseSymbolFile
   , weedSymbolFile
-  , loadSymbolFile
+  , readSymbolFile
   ) where
 
 import           Control.Monad
@@ -68,7 +68,7 @@ weedSymbolFile m =
   let pairs = [(l, a) | (a, ls) <- Map.assocs m, l <- ls]
   in  wBuildMap pairs
 
-loadSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle (Map.Map LabelName MimaAddress)
+readSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle (Map.Map LabelName MimaAddress)
-loadSymbolFile filename input = do
+readSymbolFile filename input = do
   unweeded <- parse parseSymbolFile filename input
   runWeedBundle filename input $ weedSymbolFile unweeded