Monad transformers for the first time :OO

src/Ubc/Parse/Syntax/Import.hs

@@ -1,20 +1,34 @@
 module Ubc.Parse.Syntax.Import
 (
-parse)
+parse2)
 where
 
 import Control.Monad.Catch ( SomeException () )
+import Control.Monad.Trans.Except ()
 
 import Data.Functor ((<&>))
 import Data.List.NonEmpty (NonEmpty)
 
 import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf)
 
-import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir )
+import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (</>), fromAbsFile )
 
 import qualified Ubc.Parse.Syntax.Language as UbcLanguage
 import qualified Data.List.NonEmpty as NonEmpty
-import Control.Monad (liftM2)
+import Ubc.Parse.Syntax (Transformer)
+import Control.Monad.Trans.Reader (ReaderT, asks)
+import Ubc.Parse.Syntax.Config (Config)
+import qualified Ubc.Parse.Syntax.Config as Config
+import qualified Data.Set as Set
+import Control.Arrow ((>>>))
+import qualified Data.List as List
+import Control.Monad.Trans (lift)
+import qualified System.Directory as IO
+import Control.Monad (filterM)
+
+data Import 
+        = Failed SomeException
+        | Finished
 
 importPath :: Monad m => ParsecT String u m (NonEmpty String)
 importPath = UbcLanguage.angles (many importChar `sepBy1` char '/')
@@ -26,15 +40,27 @@ importChar = choice
         , notFollowedBy (oneOf ">/") >> anyChar
         ]
 
-parse :: ParsecT String u IO [String]
-parse = do
+parse2 :: ParsecT String u Transformer Import
+parse2 = do
         UbcLanguage.reserved "import"
         fragments <- importPath
 
-        let name = Path.parseRelFile $ NonEmpty.last fragments :: Either SomeException (Path Rel File)
-        let dirPath = mapM Path.parseRelDir . NonEmpty.init $ fragments :: Either SomeException [Path Rel Dir]
+        either (pure . Failed) (lift . resolvePaths . uncurry constructPaths) $ do
+                        name <- Path.parseRelFile $ NonEmpty.last fragments
+                        dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments
+                        pure (name, dirPath)
 
-        case liftM2 (,) name dirPath of
-                Left err -> pure []
-                Right success -> pure []
+resolvePaths :: Transformer [Path Abs File] -> Transformer Import
+resolvePaths paths = do
+        existingPaths <- paths >>= filterM (lift . IO.doesFileExist . Path.fromAbsFile)
+        pure Finished
+
+constructPaths :: Path Rel File -> [Path Rel Dir] -> Transformer ([Path Abs File])
+constructPaths file dirs = do
+        paths <- asks Config.includePaths
+        Set.toList
+                >>> List.map (flip (foldl' (</>)) dirs)
+                >>> List.map (</> file)
+                >>> pure
+                $ paths