Monad transformers for the first time :OO

app/Main.hs

@@ -5,5 +5,6 @@ import qualified Ubc.Parse.Syntax.File as File
 main :: IO ()
 main = do
         text <- getContents
+        -- fixme: handle errors?
 
         print $ Parsec.parse (File.parse "<stdin>" <* Parsec.eof) "<stdin>" text 

package.yaml

@@ -25,9 +25,11 @@ dependencies:
 - directory 
 - exceptions
 - filepath
+- mtl
 - os-string
 - path
 - parsec
+- transformers
 
 ghc-options:
 - -Wall

src/Ubc/Parse/Syntax.hs

@@ -0,0 +1,7 @@
+module Ubc.Parse.Syntax
+(Transformer)
+where
+import Control.Monad.Reader (ReaderT)
+import Ubc.Parse.Syntax.Config (Config)
+
+type Transformer = ReaderT Config IO

src/Ubc/Parse/Syntax/Config.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 module Ubc.Parse.Syntax.Config
 ( Config(..)
 , defaultConfig
@@ -5,12 +8,16 @@ module Ubc.Parse.Syntax.Config
 where
 
 import Data.Set (Set)
-import qualified Data.Set as Set
+
+import Path (Path, Abs, Dir)
+import GHC.Generics (Generic, Generically(..))
 
 data Config = Config
-        { includePaths :: Set FilePath
+        { includePaths :: Set (Path Abs Dir)
         }
+        deriving stock (Generic, Show)
+        deriving (Semigroup, Monoid) via Generically Config
 
 defaultConfig :: Config
-defaultConfig = Config (Set.singleton ".")
+defaultConfig = mempty
 

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]
+parse2 :: ParsecT String u Transformer Import
-parse = do
+parse2 = do
         UbcLanguage.reserved "import"
         fragments <- importPath
 
-        let name = Path.parseRelFile $ NonEmpty.last fragments :: Either SomeException (Path Rel File)
+        either (pure . Failed) (lift . resolvePaths . uncurry constructPaths) $ do
-        let dirPath = mapM Path.parseRelDir . NonEmpty.init $ fragments :: Either SomeException [Path Rel Dir]
+                        name <- Path.parseRelFile $ NonEmpty.last fragments
+                        dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments
+                        pure (name, dirPath)
 
-        case liftM2 (,) name dirPath of
+resolvePaths :: Transformer [Path Abs File] -> Transformer Import
-                Left err -> pure []
+resolvePaths paths = do
-                Right success -> pure []
+        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
 

ubcc.cabal

@@ -25,6 +25,7 @@ source-repository head
 
 library
   exposed-modules:
+      Ubc.Parse.Syntax
       Ubc.Parse.Syntax.Config
       Ubc.Parse.Syntax.Enumeration
       Ubc.Parse.Syntax.Expression
@@ -50,9 +51,11 @@ library
     , directory
     , exceptions
     , filepath
+    , mtl
     , os-string
     , parsec
     , path
+    , transformers
   default-language: Haskell2010
 
 executable ubcc-exe
@@ -70,9 +73,11 @@ executable ubcc-exe
     , directory
     , exceptions
     , filepath
+    , mtl
     , os-string
     , parsec
     , path
+    , transformers
     , ubcc
   default-language: Haskell2010
 
@@ -92,8 +97,10 @@ test-suite ubcc-test
     , directory
     , exceptions
     , filepath
+    , mtl
     , os-string
     , parsec
     , path
+    , transformers
     , ubcc
   default-language: Haskell2010