-- | Utilities for caching file system access.
module Mikan.Interaction.ReadFile
  ( readFileTCM
  , hashSourceFile
  )
  where

import Control.Exception qualified as E
import Control.Monad.Error.Class
import Control.Monad.IO.Class

import Data.HashMap.Strict qualified as HMap
import Data.Text.Lazy qualified as LT
import Data.Text (Text)

import Mikan.TypeChecking.Monad.State
import Mikan.TypeChecking.Monad.Base

import Mikan.Syntax.Position
import Mikan.Syntax.Parser (ParseError(ReadFileError))

import Mikan.Utils.IO.UTF8 (readTextFile)
import Mikan.Utils.FileName (filePath)
import Mikan.Utils.Hash

-- | Read and hash the contents of an 'AbsolutePath' if it has not yet
-- been read in this era.
readFileTCM :: AbsolutePath -> TCM ReadFile
readFileTCM :: AbsolutePath -> TCM ReadFile
readFileTCM AbsolutePath
file = Lens' SessionState ReadFileCache
-> (ReadFileCache -> TCMT IO (ReadFile, ReadFileCache))
-> TCM ReadFile
forall a r.
Lens' SessionState a -> (a -> TCMT IO (r, a)) -> TCMT IO r
forall (m :: * -> *) a r.
ModifySession m =>
Lens' SessionState a -> (a -> m (r, a)) -> m r
stateSessionLensM (ReadFileCache -> f ReadFileCache)
-> SessionState -> f SessionState
Lens' SessionState ReadFileCache
lensReadFileCache \ReadFileCache
cache -> do
  case ReadFileCache
cache ReadFileCache
-> Getting (Maybe ReadFile) ReadFileCache (Maybe ReadFile)
-> Maybe ReadFile
forall s a. s -> Getting a s a -> a
^. Index ReadFileCache
-> Lens' ReadFileCache (Maybe (IxValue ReadFileCache))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index ReadFileCache
AbsolutePath
file of
    Just ReadFile
read
      -- it shouldn't be possible for files to come from the future, but
      -- it doesn't hurt to just use them.
      | ReadFile
read ReadFile -> Getting Word ReadFile Word -> Word
forall s a. s -> Getting a s a -> a
^. Getting Word ReadFile Word
forall a. HasFileEra a => Lens' a Word
Lens' ReadFile Word
lensEra Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= ReadFileCache
cache ReadFileCache -> Getting Word ReadFileCache Word -> Word
forall s a. s -> Getting a s a -> a
^. Getting Word ReadFileCache Word
forall a. HasFileEra a => Lens' a Word
Lens' ReadFileCache Word
lensEra -> (ReadFile, ReadFileCache) -> TCMT IO (ReadFile, ReadFileCache)
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadFile
read, ReadFileCache
cache)
    Maybe ReadFile
_ -> do
      text <- IO (Either IOError Text) -> TCMT IO (Either IOError Text)
forall a. IO a -> TCMT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> IO (Either IOError Text)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (FilePath -> IO Text
readTextFile (AbsolutePath -> FilePath
filePath AbsolutePath
file))) TCMT IO (Either IOError Text)
-> (Either IOError Text -> TCMT IO StrictText)
-> TCMT IO StrictText
forall a b. TCMT IO a -> (a -> TCMT IO b) -> TCMT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (IOError
err :: IOError) -> TCErr -> TCMT IO StrictText
forall a. TCErr -> TCMT IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCErr -> TCMT IO StrictText) -> TCErr -> TCMT IO StrictText
forall a b. (a -> b) -> a -> b
$ ParseError -> TCErr
ParserError (ParseError -> TCErr) -> ParseError -> TCErr
forall a b. (a -> b) -> a -> b
$ RangeFile -> IOError -> ParseError
ReadFileError (AbsolutePath -> Maybe (TopLevelModuleName' Range) -> RangeFile
RangeFile AbsolutePath
file Maybe (TopLevelModuleName' Range)
forall a. Maybe a
Nothing) IOError
err
        Right Text
text -> StrictText -> TCMT IO StrictText
forall a. a -> TCMT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictText -> TCMT IO StrictText)
-> StrictText -> TCMT IO StrictText
forall a b. (a -> b) -> a -> b
$! Text -> StrictText
LT.toStrict Text
text
      let
        !hash = StrictText -> Hash
hashText StrictText
text
        rf = ReadFile
          { readFileHash :: Hash
readFileHash = Hash
hash
          , readFileText :: StrictText
readFileText = StrictText
text
          , readFileEra :: Word
readFileEra  = ReadFileCache
cache ReadFileCache -> Getting Word ReadFileCache Word -> Word
forall s a. s -> Getting a s a -> a
^. Getting Word ReadFileCache Word
forall a. HasFileEra a => Lens' a Word
Lens' ReadFileCache Word
lensEra
          }
        !cache' = ReadFileCache
cache ReadFileCache -> (ReadFileCache -> ReadFileCache) -> ReadFileCache
forall a b. a -> (a -> b) -> b
& Index ReadFileCache
-> Lens' ReadFileCache (Maybe (IxValue ReadFileCache))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index ReadFileCache
AbsolutePath
file ((Maybe ReadFile -> Identity (Maybe ReadFile))
 -> ReadFileCache -> Identity ReadFileCache)
-> ReadFile -> ReadFileCache -> ReadFileCache
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ReadFile
rf
      pure (rf, cache')

-- | Get the hash of a source file.
hashSourceFile :: SourceFile -> TCM Hash
hashSourceFile :: SourceFile -> TCM Hash
hashSourceFile SourceFile
file = do
  !path <- SourceFile -> TCMT IO AbsolutePath
forall (m :: * -> *). MonadFileId m => SourceFile -> m AbsolutePath
srcFilePath SourceFile
file
  readFileHash <$> readFileTCM path