more effect stuff, incl. ST

lib/Quox/Parser/LoadFile.idr

@@ -0,0 +1,98 @@
+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 ()