Refactored, added comments

This commit is contained in:
VegOwOtenks 2025-02-19 23:05:13 +01:00
parent 9652b4e13b
commit 6242b2f1eb

View file

@ -11,7 +11,7 @@ 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 Control.Monad.Trans.Reader (asks, ReaderT)
import Data.Functor ((<&>))
@ -22,18 +22,20 @@ 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 Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf, option)
import qualified Text.Parsec as Parsec
import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (</>), fromAbsFile, fromRelFile )
import Ubc.Parse.Syntax (Transformer)
import Ubc.Parse.Syntax.Config (Config)
import qualified Ubc.Parse.Syntax.Config as Config
import qualified Ubc.Parse.Syntax.File as File
import qualified Ubc.Parse.Syntax.Language as UbcLanguage
data Import = Import
{ file :: File.File
, alias :: String
}
importPath :: Monad m => ParsecT String u m (NonEmpty String)
@ -50,19 +52,27 @@ parse :: ParsecT String u Transformer Import
parse = do
UbcLanguage.reserved "import"
fragments <- importPath
importAs <- option (NonEmpty.last fragments) importAlias
case parseRelPath fragments of
-- concatenate directory and file parts, also utf-decoding
relFile <- case parseRelPath fragments of
Left err -> fail $ "Failed to decode path:\n" <> show err
Right relFile -> do
possiblePaths <- lift $ constructPaths relFile
existingFiles <- liftIO $ filterInexistent possiblePaths
tryImport relFile possiblePaths existingFiles
Right relFile -> pure relFile
tryImport :: Path Rel File -> [Path Abs File] -> [Path Abs File] -> ParsecT String u Transformer Import
tryImport targetFile searchedPaths = \case
[] -> fail $ notFoundMessage targetFile searchedPaths
[path] -> parseFile path
fs@_ -> fail $ multipleFoundMessage targetFile fs
-- appended to all search directories
possiblePaths <- lift $ constructPaths relFile
-- only existing files
existingFiles <- liftIO $ filterInexistent possiblePaths
-- fail if there are multiple files
case existingFiles of
[] -> fail $ notFoundMessage relFile possiblePaths
[path] -> parseFile path importAs
fs@_ -> fail $ multipleFoundMessage relFile fs
importAlias :: Monad m => ParsecT String u m String
importAlias = UbcLanguage.reserved "as"
*> UbcLanguage.identifier
multipleFoundMessage :: Path Rel File -> [Path Abs File] -> String
multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Path.fromRelFile relFile <> "\n"
@ -74,8 +84,8 @@ notFoundMessage relFile searchedLocations = "Could not locate import file path"
<> "Searched locations were:"
<> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations)
parseFile :: MonadIO m => Path Abs File -> ParsecT String u m Import
parseFile path = do
parseFile :: MonadIO m => Path Abs File -> String -> ParsecT String u m Import
parseFile path importAs = do
let stringPath = Path.fromAbsFile path
contents <- liftIO . readFile $ stringPath
@ -98,7 +108,7 @@ parseFile path = do
Parsec.setInput oldInput
Parsec.setPosition oldPosition
pure $ Import importedFile
pure $ Import importedFile importAs
parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File)
parseRelPath fragments = do
@ -112,7 +122,7 @@ 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 :: Monad m => Path Rel t -> ReaderT Config m [Path Abs t]
constructPaths suffix = do
paths <- asks Config.includePaths
Set.toList