quox/lib/Quox/Parser/LoadFile.idr

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 ()