Import file parsing

src/Ubc/Parse/Syntax/Import.hs

@@ -1,34 +1,40 @@
+{-# LANGUAGE LambdaCase #-}
 module Ubc.Parse.Syntax.Import
-(
+( parse
-parse2)
+, Import(..)
+)
 where
 
-import Control.Monad.Catch ( SomeException () )
+import Control.Arrow ((>>>))
+
+import Control.Monad (filterM)
+import Control.Monad.Catch ( MonadThrow, )
+import Control.Monad.Trans (lift, MonadIO (liftIO))
 import Control.Monad.Trans.Except ()
+import Control.Monad.Trans.Reader (asks)
 
 import Data.Functor ((<&>))
+
 import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List as List
+import qualified Data.Set as Set
+import qualified Data.List.NonEmpty as NonEmpty
+
+import qualified System.Directory as IO
 
 import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf)
+import qualified Text.Parsec as Parsec
 
-import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (</>), fromAbsFile )
+import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (</>), fromAbsFile, fromRelFile )
 
-import qualified Ubc.Parse.Syntax.Language as UbcLanguage
-import qualified Data.List.NonEmpty as NonEmpty
 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 qualified Ubc.Parse.Syntax.File as File
-import Control.Arrow ((>>>))
+import qualified Ubc.Parse.Syntax.Language as UbcLanguage
-import qualified Data.List as List
-import Control.Monad.Trans (lift)
-import qualified System.Directory as IO
-import Control.Monad (filterM)
 
-data Import 
+data Import = Import
-        = Failed SomeException
+        { file :: File.File
-        | Finished
+        }
 
 importPath :: Monad m => ParsecT String u m (NonEmpty String)
 importPath = UbcLanguage.angles (many importChar `sepBy1` char '/')
@@ -40,27 +46,77 @@ importChar = choice
         , notFollowedBy (oneOf ">/") >> anyChar
         ]
 
-parse2 :: ParsecT String u Transformer Import
+parse :: ParsecT String u Transformer Import
-parse2 = do
+parse = do
         UbcLanguage.reserved "import"
         fragments <- importPath
 
-        either (pure . Failed) (lift . resolvePaths . uncurry constructPaths) $ do
+        case parseRelPath fragments of
-                        name <- Path.parseRelFile $ NonEmpty.last fragments
+                Left err -> fail $ "Failed to decode path:\n" <> show err
-                        dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments
+                Right relFile -> do
-                        pure (name, dirPath)
+                        possiblePaths <- lift $ constructPaths relFile
+                        existingFiles <- liftIO $ filterInexistent possiblePaths
+                        tryImport relFile possiblePaths existingFiles
 
-resolvePaths :: Transformer [Path Abs File] -> Transformer Import
+tryImport :: Path Rel File -> [Path Abs File] -> [Path Abs File] -> ParsecT String u Transformer Import
-resolvePaths paths = do
+tryImport targetFile searchedPaths = \case
-        existingPaths <- paths >>= filterM (lift . IO.doesFileExist . Path.fromAbsFile)
+        [] -> fail $ notFoundMessage targetFile searchedPaths
-        pure Finished
+        [path] -> parseFile path
+        fs@_ -> fail $ multipleFoundMessage targetFile fs
 
-constructPaths :: Path Rel File -> [Path Rel Dir] -> Transformer ([Path Abs File])
+multipleFoundMessage :: Path Rel File -> [Path Abs File] -> String
-constructPaths file dirs = do
+multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Path.fromRelFile relFile <> "\n"
+        <> "Found multiple files in the search path:"
+        <> (unlines . List.map (Path.fromAbsFile >>> ('\t':)) $ foundFiles)
+
+notFoundMessage :: Path Rel File -> [Path Abs File] -> String
+notFoundMessage relFile searchedLocations = "Could not locate import file path" <> Path.fromRelFile relFile <> "\n"
+                <> "Searched locations were:"
+                <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations)
+
+parseFile :: MonadIO m => Path Abs File -> ParsecT String u m Import
+parseFile path = do
+        let stringPath = Path.fromAbsFile path
+        contents <- liftIO . readFile $ stringPath
+
+        -- save old state
+        oldInput <- Parsec.getInput
+        oldPosition <- Parsec.getPosition
+
+        -- calculate new state
+        let newPosition = (flip Parsec.setSourceName) stringPath
+                >>> (flip Parsec.setSourceLine) 1
+                >>> (flip Parsec.setSourceColumn) 1
+                $ oldPosition
+
+        -- prepare new state
+        Parsec.setInput contents
+        Parsec.setPosition newPosition
+        importedFile <- File.parse stringPath 
+
+        -- restore old state
+        Parsec.setInput oldInput
+        Parsec.setPosition oldPosition
+
+        pure $ Import importedFile
+
+parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File)
+parseRelPath fragments = do
+        name <- Path.parseRelFile $ NonEmpty.last fragments
+        dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments
+        pure $ constructRelative name dirPath
+
+constructRelative :: Path Rel t -> [Path Rel Dir] -> Path Rel t
+constructRelative = foldr (</>)
+
+filterInexistent :: [Path Abs File] -> IO [Path Abs File]
+filterInexistent paths = filterM (IO.doesFileExist . Path.fromAbsFile) paths
+
+constructPaths :: Path Rel File -> Transformer [Path Abs File]
+constructPaths suffix = do
         paths <- asks Config.includePaths
         Set.toList
-                >>> List.map (flip (foldl' (</>)) dirs)
+                >>> List.map (</> suffix)
-                >>> List.map (</> file)
                 >>> pure
                 $ paths