quox/lib/Quox/Parser/LoadFile.idr

98 lines
2.3 KiB
Idris

module Quox.Parser.LoadFile
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 String
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 String
doLoadAt lbl loc file = send $ DoLoad {lbl} loc file
export %inline
doLoad : Has LoadFile fs => Loc -> FilePath -> Eff fs String
doLoad = doLoadAt ()
public export
SeenSet : Type
SeenSet = SortedSet FilePath
public export
IncludePath : Type
IncludePath = List String
public export
ErrorWrapper : Type -> Type
ErrorWrapper e = Loc -> FilePath -> FileError -> e
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 : ErrorWrapper e ->
IORef SeenSet -> IncludePath ->
LoadFileL lbl a -> IOErr e a
handleLoadFileIOE inj seen inc = \case
Seen f => contains f <$> readIORef seen
SetSeen f => modifyIORef seen $ insert f
DoLoad l f => readFileFrom inc f >>= either (ioLeft . inj l f) pure
export
loadFileAt : (0 lbl : k) -> Has (LoadFileL lbl) fs =>
Loc -> FilePath -> Eff fs (Maybe String)
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 String)
loadFile = loadFileAt ()