quox/lib/Quox/Parser/LoadFile.idr

100 lines
2.4 KiB
Idris

module Quox.Parser.LoadFile
import public Quox.Parser.Syntax
import Quox.Parser.Parser
import Quox.Loc
import Quox.EffExtra
import Data.IORef
import Data.SortedSet
import System.File
import System.Path
%default total
public export
FilePath : Type
FilePath = String
public export
data LoadFileL : (lbl : k) -> Type -> Type where
[search lbl]
Seen : FilePath -> LoadFileL lbl Bool
SetSeen : FilePath -> LoadFileL lbl ()
DoLoad : Loc -> FilePath -> LoadFileL lbl PFile
public export
LoadFile : Type -> Type
LoadFile = LoadFileL ()
export
seenAt : (0 lbl : k) -> Has (LoadFileL lbl) fs => FilePath -> Eff fs Bool
seenAt lbl file = send $ Seen {lbl} file
export %inline
seen : Has LoadFile fs => FilePath -> Eff fs Bool
seen = seenAt ()
export
setSeenAt : (0 lbl : k) -> Has (LoadFileL lbl) fs => FilePath -> Eff fs ()
setSeenAt lbl file = send $ SetSeen {lbl} file
export %inline
setSeen : Has LoadFile fs => FilePath -> Eff fs ()
setSeen = setSeenAt ()
export
doLoadAt : (0 lbl : k) -> Has (LoadFileL lbl) fs =>
Loc -> FilePath -> Eff fs PFile
doLoadAt lbl loc file = send $ DoLoad {lbl} loc file
export %inline
doLoad : Has LoadFile fs => Loc -> FilePath -> Eff fs PFile
doLoad = doLoadAt ()
public export
SeenSet : Type
SeenSet = SortedSet FilePath
public export
IncludePath : Type
IncludePath = List String
export covering
readFileFrom : HasIO io => IncludePath -> FilePath ->
io (Either FileError String)
readFileFrom inc f =
case !(firstExists $ map (</> f) inc) of
Just path => readFile path
Nothing => pure $ Left $ FileNotFound
export covering
handleLoadFileIOE : (Loc -> FilePath -> FileError -> e) ->
(FilePath -> Parser.Error -> e) ->
IORef SeenSet -> IncludePath ->
LoadFileL lbl a -> IOErr e a
handleLoadFileIOE injf injp seen inc = \case
Seen f => contains f <$> readIORef seen
SetSeen f => modifyIORef seen $ insert f
DoLoad l f =>
case !(readFileFrom inc f) of
Left err => ioLeft $ injf l f err
Right str => either (ioLeft . injp f) pure $ lexParseInput f str
export
loadFileAt : (0 lbl : k) -> Has (LoadFileL lbl) fs =>
Loc -> FilePath -> Eff fs (Maybe PFile)
loadFileAt lbl loc file =
if !(seenAt lbl file)
then pure Nothing
else Just <$> doLoadAt lbl loc file <* setSeenAt lbl file
export
loadFile : Has LoadFile fs => Loc -> FilePath -> Eff fs (Maybe PFile)
loadFile = loadFileAt ()