Properly load flag and symbol files

app/MimaAsm/Main.hs

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

app/MimaRun/Main.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
 import           Control.Monad
 import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Except
+import           Data.Maybe
+import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import           Options.Applicative
 import           System.FilePath
@@ -14,6 +17,7 @@ import           Mima.Label
 import           Mima.Load
 import           Mima.Options
 import           Mima.Parse.FlagFile
+import           Mima.Parse.SymbolFile
 import           Mima.State
 import           Mima.Util
 import           Mima.Word
@@ -33,6 +37,26 @@ data Settings = Settings
   , formatConf :: FormatConfig
   } deriving (Show)
 
+getFlagFile :: Settings -> File
+getFlagFile settings =
+  case flagFile settings of
+    Just path -> RequiredFile path
+    Nothing   -> case discover settings of
+      False -> NoFile
+      True  -> OptionalFile discoveredPath
+  where
+    discoveredPath = dropExtension (infile settings) ++ ".mima-flags"
+
+getSymbolFile :: Settings -> File
+getSymbolFile settings =
+  case symbolFile settings of
+    Just path -> RequiredFile path
+    Nothing   -> case discover settings of
+      False -> NoFile
+      True  -> OptionalFile discoveredPath
+  where
+    discoveredPath = dropExtension (infile settings) ++ ".mima-symbols"
+
 {- Command-line parameters -}
 
 settingsParser :: Parser Settings
@@ -74,40 +98,30 @@ settingsParser = Settings
 opts :: ParserInfo Settings
 opts = info (helper <*> settingsParser) $ fullDesc <> failureCode 1 <> footer flagFooter
 
-{- Loading the flag file -}
+{- Loading supplemental files -}
 
--- If explicit file name:
+printFile :: T.Text -> File -> Run ()
---   Try to load file
+printFile name NoFile =
---   Fail if loading fails
+  lift $ T.putStrLn $ "Not loading " <> name <> ": No file specified and discovery turned off"
--- Elif discover:
+printFile name (OptionalFile path) =
---   Try to load file
+  lift $ T.putStrLn $ "Attempting to load " <> name <> " from " <> T.pack path
---   Use defaults if loading fails
+printFile name (RequiredFile path) =
--- Else:
+  lift $ T.putStrLn $ "Loading " <> name <> " from " <> T.pack path
---   Use defaults
-
-loadFlagFile :: FilePath -> Run (Flags (MimaAddress -> Bool))
-loadFlagFile filename = do
-  lift $ putStrLn $ "Loading flags from " ++ filename
-  (interpretFlagSpec . getFlagSpec) <$> loadFile readFlagFile filename
-
-withDefaultFlags :: Run (Flags (MimaAddress -> Bool)) -> Run (Flags (MimaAddress -> Bool))
-withDefaultFlags p = do
-  result <- tryRun p
-  case result of
-    Just flags -> pure flags
-    Nothing -> do
-      lift $ putStrLn "Using default flags"
-      pure noFlags
 
 loadFlags :: Settings -> Run (Flags (MimaAddress -> Bool))
-loadFlags settings =
+loadFlags settings = do
-  case flagFile settings of
+  let file = getFlagFile settings
-    Just filename -> loadFlagFile filename
+  printFile "flags" file
-    Nothing -> withDefaultFlags $ if discover settings
+  mRawFlags <- loadFile readFlagFile file
-      then loadFlagFile discovered
+  pure $ case mRawFlags of
-      else throwE "File not specified and discovery turned off"
+    Nothing       -> noFlags
-  where
+    Just flagSpec -> interpretFlagSpec $ getFlagSpec flagSpec
-    discovered = dropExtension (infile settings) ++ ".mima-flags"
+
+loadSymbols :: Settings -> Run LabelSpec
+loadSymbols settings = do
+  let file = getSymbolFile settings
+  printFile "symbols" file
+  fromMaybe noLabels <$> loadFile readSymbolFile file
 
 {- Other functions -}
 
@@ -150,7 +164,7 @@ main = doRun_ $ do
   ms <- loadStateFromFile (infile settings)
 
   flags  <- loadFlags settings
-  labels <- pure noLabels -- loadSymbolFile settings
+  labels <- loadSymbols settings
 
   ms' <- if norun settings
     then pure ms

src/Mima/IO.hs

@@ -1,12 +1,15 @@
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TupleSections #-}
 
 module Mima.IO
   ( Run
   , doRun
   , doRun_
   , tryRun
+  , File(..)
   , readTextFile
   , loadFile
+  , loadFile'
   ) where
 
 import           Control.Monad.Trans.Class
@@ -39,6 +42,12 @@ tryRun r = do
       lift $ putStrLn e
       pure Nothing
 
+data File
+  = NoFile
+  | OptionalFile FilePath
+  | RequiredFile FilePath
+  deriving (Show)
+
 readTextFile :: FilePath -> Run T.Text
 readTextFile filepath = do
   eitherContent <- lift $ catchIOError (Right <$> T.readFile filepath) handleError
@@ -49,9 +58,27 @@ readTextFile filepath = do
       then pure $ Left $ "Can't load file " ++ filepath ++ ": " ++ ioeGetErrorString e
       else ioError e -- This error does not concern us
 
-loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a
+loadTextFile :: File -> Run (Maybe (FilePath, T.Text))
-loadFile f filepath = do
+loadTextFile NoFile              = pure Nothing
-  content <- readTextFile filepath
+loadTextFile (OptionalFile path) = do
-  case f filepath content of
+  mContent <- tryRun $ readTextFile path
+  pure $ (path,) <$> mContent
+loadTextFile (RequiredFile path) = do
+  content <- readTextFile path
+  pure $ Just (path, content)
+
+loadFile :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> File -> Run (Maybe a)
+loadFile f file = do
+  mContent <- loadTextFile file
+  case mContent of
+    Nothing              -> pure Nothing
+    Just (path, content) -> case f path content of
       Left errorBundle -> throwE $ errorBundlePretty errorBundle
-    Right a           -> pure a
+      Right result     -> pure $ Just result
+
+loadFile' :: (FilePath -> T.Text -> Either WeedErrorBundle a) -> FilePath -> Run a
+loadFile' f path = do
+  content <- readTextFile path
+  case f path content of
+    Left errorBundle -> throwE $ errorBundlePretty errorBundle
+    Right result     -> pure result

src/Mima/Parse/SymbolFile.hs

@@ -47,13 +47,12 @@ parseSymbolFile = space *> many lNewline *> (combineLines <$> many lLine) <* eof
 
 {- Weeding -}
 
-wBuildMap :: [(WithOffset LabelName, MimaAddress)]
+wBuildMap :: [(WithOffset LabelName, MimaAddress)] -> Weed WeedError LabelSpec
-          -> Weed WeedError (Map.Map LabelName MimaAddress)
 wBuildMap = foldM helper Map.empty
   where
     helper :: Map.Map LabelName MimaAddress
            -> (WithOffset LabelName, MimaAddress)
-           -> Weed WeedError (Map.Map LabelName MimaAddress)
+           -> Weed WeedError LabelSpec
     helper m (l, addr)
       | name `Map.member` m = do
           harmless $ errorAt l "label was specified more than once"
@@ -62,12 +61,12 @@ wBuildMap = foldM helper Map.empty
         where name = woValue l
 
 weedSymbolFile :: Map.Map MimaAddress [WithOffset LabelName]
-               -> Weed WeedError (Map.Map LabelName MimaAddress)
+               -> Weed WeedError LabelSpec
 weedSymbolFile m =
   let pairs = [(l, a) | (a, ls) <- Map.assocs m, l <- ls]
   in  wBuildMap pairs
 
-readSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle (Map.Map LabelName MimaAddress)
+readSymbolFile :: FilePath -> T.Text -> Either WeedErrorBundle LabelSpec
 readSymbolFile filename input = do
   unweeded <- parse parseSymbolFile filename input
   runWeedBundle filename input $ weedSymbolFile unweeded