{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Cryptol.Project.Monad
  ( LoadM, Err, NoErr
  , ScanStatus(..), ChangeStatus(..), InvalidStatus(..), Parsed
  , LoadProjectMode(..)
  , runLoadM
  , doModule
  , doModuleNonFail
  , doIO
  , tryLoadM
  , liftCallback
  , addFingerprint
  , addScanned
  , getModulePathLabel
  , getCachedFingerprint
  , findModule'
  , getStatus
  , getFingerprint
  , lPutStrLn
  , getOldDocstringResults
  ) where

import           Data.Map.Strict                  (Map)
import qualified Data.Map.Strict                  as Map
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Except hiding (tryError)
import           System.Directory
import           System.FilePath                  (makeRelative)

import           Cryptol.Utils.Ident
import           Cryptol.Parser.AST               (Module,PName)
import           Cryptol.ModuleSystem.Base        as M
import           Cryptol.ModuleSystem.Monad       as M
import           Cryptol.ModuleSystem.Env
import           Cryptol.Utils.Logger             (logPutStrLn)

import           Cryptol.Project.Config
import           Cryptol.Project.Cache

newtype LoadM err a =
  LoadM (ReaderT LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a)
  deriving ((forall a b. (a -> b) -> LoadM err a -> LoadM err b)
-> (forall a b. a -> LoadM err b -> LoadM err a)
-> Functor (LoadM err)
forall a b. a -> LoadM err b -> LoadM err a
forall a b. (a -> b) -> LoadM err a -> LoadM err b
forall err a b. a -> LoadM err b -> LoadM err a
forall err a b. (a -> b) -> LoadM err a -> LoadM err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall err a b. (a -> b) -> LoadM err a -> LoadM err b
fmap :: forall a b. (a -> b) -> LoadM err a -> LoadM err b
$c<$ :: forall err a b. a -> LoadM err b -> LoadM err a
<$ :: forall a b. a -> LoadM err b -> LoadM err a
Functor,Functor (LoadM err)
Functor (LoadM err) =>
(forall a. a -> LoadM err a)
-> (forall a b. LoadM err (a -> b) -> LoadM err a -> LoadM err b)
-> (forall a b c.
    (a -> b -> c) -> LoadM err a -> LoadM err b -> LoadM err c)
-> (forall a b. LoadM err a -> LoadM err b -> LoadM err b)
-> (forall a b. LoadM err a -> LoadM err b -> LoadM err a)
-> Applicative (LoadM err)
forall err. Functor (LoadM err)
forall a. a -> LoadM err a
forall err a. a -> LoadM err a
forall a b. LoadM err a -> LoadM err b -> LoadM err a
forall a b. LoadM err a -> LoadM err b -> LoadM err b
forall a b. LoadM err (a -> b) -> LoadM err a -> LoadM err b
forall err a b. LoadM err a -> LoadM err b -> LoadM err a
forall err a b. LoadM err a -> LoadM err b -> LoadM err b
forall err a b. LoadM err (a -> b) -> LoadM err a -> LoadM err b
forall a b c.
(a -> b -> c) -> LoadM err a -> LoadM err b -> LoadM err c
forall err a b c.
(a -> b -> c) -> LoadM err a -> LoadM err b -> LoadM err c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall err a. a -> LoadM err a
pure :: forall a. a -> LoadM err a
$c<*> :: forall err a b. LoadM err (a -> b) -> LoadM err a -> LoadM err b
<*> :: forall a b. LoadM err (a -> b) -> LoadM err a -> LoadM err b
$cliftA2 :: forall err a b c.
(a -> b -> c) -> LoadM err a -> LoadM err b -> LoadM err c
liftA2 :: forall a b c.
(a -> b -> c) -> LoadM err a -> LoadM err b -> LoadM err c
$c*> :: forall err a b. LoadM err a -> LoadM err b -> LoadM err b
*> :: forall a b. LoadM err a -> LoadM err b -> LoadM err b
$c<* :: forall err a b. LoadM err a -> LoadM err b -> LoadM err a
<* :: forall a b. LoadM err a -> LoadM err b -> LoadM err a
Applicative,Applicative (LoadM err)
Applicative (LoadM err) =>
(forall a b. LoadM err a -> (a -> LoadM err b) -> LoadM err b)
-> (forall a b. LoadM err a -> LoadM err b -> LoadM err b)
-> (forall a. a -> LoadM err a)
-> Monad (LoadM err)
forall err. Applicative (LoadM err)
forall a. a -> LoadM err a
forall err a. a -> LoadM err a
forall a b. LoadM err a -> LoadM err b -> LoadM err b
forall a b. LoadM err a -> (a -> LoadM err b) -> LoadM err b
forall err a b. LoadM err a -> LoadM err b -> LoadM err b
forall err a b. LoadM err a -> (a -> LoadM err b) -> LoadM err b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall err a b. LoadM err a -> (a -> LoadM err b) -> LoadM err b
>>= :: forall a b. LoadM err a -> (a -> LoadM err b) -> LoadM err b
$c>> :: forall err a b. LoadM err a -> LoadM err b -> LoadM err b
>> :: forall a b. LoadM err a -> LoadM err b -> LoadM err b
$creturn :: forall err a. a -> LoadM err a
return :: forall a. a -> LoadM err a
Monad)

-- | Computations may raise an error
data Err

-- | Computations may not raise errors
data NoErr

type Parsed = [ (Module PName, [(ImportSource, ModulePath)]) ]

data ScanStatus =
    Scanned ChangeStatus FullFingerprint Parsed
  | Invalid InvalidStatus
  deriving Int -> ScanStatus -> ShowS
[ScanStatus] -> ShowS
ScanStatus -> FilePath
(Int -> ScanStatus -> ShowS)
-> (ScanStatus -> FilePath)
-> ([ScanStatus] -> ShowS)
-> Show ScanStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScanStatus -> ShowS
showsPrec :: Int -> ScanStatus -> ShowS
$cshow :: ScanStatus -> FilePath
show :: ScanStatus -> FilePath
$cshowList :: [ScanStatus] -> ShowS
showList :: [ScanStatus] -> ShowS
Show

data ChangeStatus =
    Changed       -- ^ The module, or one of its dependencies changed.
  | Unchanged     -- ^ The module did not change.
  deriving (ChangeStatus -> ChangeStatus -> Bool
(ChangeStatus -> ChangeStatus -> Bool)
-> (ChangeStatus -> ChangeStatus -> Bool) -> Eq ChangeStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeStatus -> ChangeStatus -> Bool
== :: ChangeStatus -> ChangeStatus -> Bool
$c/= :: ChangeStatus -> ChangeStatus -> Bool
/= :: ChangeStatus -> ChangeStatus -> Bool
Eq, Int -> ChangeStatus -> ShowS
[ChangeStatus] -> ShowS
ChangeStatus -> FilePath
(Int -> ChangeStatus -> ShowS)
-> (ChangeStatus -> FilePath)
-> ([ChangeStatus] -> ShowS)
-> Show ChangeStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeStatus -> ShowS
showsPrec :: Int -> ChangeStatus -> ShowS
$cshow :: ChangeStatus -> FilePath
show :: ChangeStatus -> FilePath
$cshowList :: [ChangeStatus] -> ShowS
showList :: [ChangeStatus] -> ShowS
Show)

data InvalidStatus =
    InvalidModule ModuleError
    -- ^ Error in one of the modules in this file

  | InvalidDep ImportSource ModulePath
    -- ^ Error in one of our dependencies
  deriving Int -> InvalidStatus -> ShowS
[InvalidStatus] -> ShowS
InvalidStatus -> FilePath
(Int -> InvalidStatus -> ShowS)
-> (InvalidStatus -> FilePath)
-> ([InvalidStatus] -> ShowS)
-> Show InvalidStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidStatus -> ShowS
showsPrec :: Int -> InvalidStatus -> ShowS
$cshow :: InvalidStatus -> FilePath
show :: InvalidStatus -> FilePath
$cshowList :: [InvalidStatus] -> ShowS
showList :: [InvalidStatus] -> ShowS
Show


data LoadState = LoadState
  { LoadState -> Map (ModName, [FilePath]) ModulePath
findModuleCache :: Map (ModName, [FilePath]) ModulePath
    -- ^ Map (module name, search path) -> module path

  , LoadState -> Map CacheModulePath FullFingerprint
fingerprints    :: Map CacheModulePath FullFingerprint
    -- ^ Hashes of known things.

  , LoadState -> Map ModulePath ScanStatus
scanned         :: Map ModulePath ScanStatus
    -- ^ Information about the proccessed top-level modules.
  }


-- | Information about the current project.
data LoadConfig = LoadConfig
  { LoadConfig -> FilePath
canonRoot :: FilePath
    -- ^ Path to the project root, cannoicalized.

  , LoadConfig -> LoadCache
loadCache :: LoadCache
    -- ^ The state of the cache before we started loading the project.
  }


-- | Do an operation in the module monad.
doModuleNonFail :: M.ModuleM a -> LoadM any a
doModuleNonFail :: forall a any. ModuleM a -> LoadM any a
doModuleNonFail ModuleM a
m =
  do Either ModuleError a
mb <- ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Either ModuleError a)
-> LoadM any (Either ModuleError a)
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (ExceptT
  ModuleError (StateT LoadState ModuleM) (Either ModuleError a)
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Either ModuleError a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT LoadConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT LoadState ModuleM (Either ModuleError a)
-> ExceptT
     ModuleError (StateT LoadState ModuleM) (Either ModuleError a)
forall (m :: * -> *) a. Monad m => m a -> ExceptT ModuleError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleM (Either ModuleError a)
-> StateT LoadState ModuleM (Either ModuleError a)
forall (m :: * -> *) a. Monad m => m a -> StateT LoadState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ModuleM a -> ModuleM (Either ModuleError a)
forall a. ModuleM a -> ModuleM (Either ModuleError a)
M.tryModule ModuleM a
m))))
     case Either ModuleError a
mb of
       Left ModuleError
err -> ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM any a
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (ModuleError
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
forall a.
ModuleError
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ModuleError
err)
       Right a
a  -> a -> LoadM any a
forall a. a -> LoadM any a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Do an operation in the module monad.
doModule :: M.ModuleM a -> LoadM Err a
doModule :: forall a. ModuleM a -> LoadM Err a
doModule = ModuleM a -> LoadM Err a
forall a any. ModuleM a -> LoadM any a
doModuleNonFail

-- | Do an operation in the IO monad
doIO :: IO a -> LoadM Err a
doIO :: forall a. IO a -> LoadM Err a
doIO IO a
m = ModuleM a -> LoadM Err a
forall a. ModuleM a -> LoadM Err a
doModule (IO a -> ModuleM a
forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
M.io IO a
m)

tryLoadM :: LoadM Err a -> LoadM any (Either M.ModuleError a)
tryLoadM :: forall a any. LoadM Err a -> LoadM any (Either ModuleError a)
tryLoadM (LoadM ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
m) = ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Either ModuleError a)
-> LoadM any (Either ModuleError a)
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Either ModuleError a)
forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
tryError ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
m)

-- Introduced in mtl-2.3.1 which we can't rely upon yet
tryError :: MonadError e m => m a -> m (Either e a)
tryError :: forall e (m :: * -> *) a. MonadError e m => m a -> m (Either e a)
tryError m a
action = (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
action) m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Either e a -> m (Either e a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)

-- | Print a line
lPutStrLn :: String -> LoadM any ()
lPutStrLn :: forall any. FilePath -> LoadM any ()
lPutStrLn FilePath
msg = ModuleM () -> LoadM any ()
forall a any. ModuleM a -> LoadM any a
doModuleNonFail ((Logger -> FilePath -> IO ()) -> FilePath -> ModuleM ()
forall a b. (Logger -> a -> IO b) -> a -> ModuleM b
withLogger Logger -> FilePath -> IO ()
logPutStrLn FilePath
msg)

-- | Lift a module level operation to the LoadM monad.
liftCallback :: (forall a. ModuleM a -> ModuleM a) -> LoadM any b -> LoadM Err b
liftCallback :: forall any b.
(forall a. ModuleM a -> ModuleM a) -> LoadM any b -> LoadM Err b
liftCallback forall a. ModuleM a -> ModuleM a
f (LoadM ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) b
m) =
  do LoadConfig
r <- ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadConfig
-> LoadM Err LoadConfig
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
     LoadState
s <- ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadState
-> LoadM Err LoadState
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadState
forall s (m :: * -> *). MonadState s m => m s
get
     (Either ModuleError b
mb,LoadState
s1) <- ModuleM (Either ModuleError b, LoadState)
-> LoadM Err (Either ModuleError b, LoadState)
forall a. ModuleM a -> LoadM Err a
doModule (ModuleM (Either ModuleError b, LoadState)
-> ModuleM (Either ModuleError b, LoadState)
forall a. ModuleM a -> ModuleM a
f (StateT LoadState ModuleM (Either ModuleError b)
-> LoadState -> ModuleM (Either ModuleError b, LoadState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT ModuleError (StateT LoadState ModuleM) b
-> StateT LoadState ModuleM (Either ModuleError b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) b
-> LoadConfig -> ExceptT ModuleError (StateT LoadState ModuleM) b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) b
m LoadConfig
r)) LoadState
s))
     ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
-> LoadM Err ()
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (LoadState
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put LoadState
s1)
     case Either ModuleError b
mb of
       Left ModuleError
err -> ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) b
-> LoadM Err b
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (ModuleError
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) b
forall a.
ModuleError
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ModuleError
err)
       Right b
a  -> b -> LoadM Err b
forall a. a -> LoadM Err a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a

-- | Run a LoadM computation using the given configuration.
runLoadM ::
  LoadProjectMode {- ^ force a refresh -} ->
  Config ->
  LoadM NoErr a ->
  M.ModuleM (Map CacheModulePath FullFingerprint, Map ModulePath ScanStatus, Either ModuleError a)
runLoadM :: forall a.
LoadProjectMode
-> Config
-> LoadM NoErr a
-> ModuleM
     (Map CacheModulePath FullFingerprint, Map ModulePath ScanStatus,
      Either ModuleError a)
runLoadM LoadProjectMode
mode Config
cfg (LoadM ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
m) =
  do LoadConfig
loadCfg <-
       IO LoadConfig -> ModuleT IO LoadConfig
forall (m :: * -> *) a. BaseM m IO => IO a -> ModuleT m a
M.io
         do FilePath
path  <- FilePath -> IO FilePath
canonicalizePath (Config -> FilePath
root Config
cfg)
            LoadCache
cache <- case LoadProjectMode
mode of
                       LoadProjectMode
RefreshMode  -> LoadCache -> IO LoadCache
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadCache
emptyLoadCache
                       LoadProjectMode
UntestedMode -> IO LoadCache
loadLoadCache
                       LoadProjectMode
ModifiedMode -> IO LoadCache
loadLoadCache
            LoadConfig -> IO LoadConfig
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadConfig { canonRoot :: FilePath
canonRoot = FilePath
path
                            , loadCache :: LoadCache
loadCache = LoadCache
cache
                            }
     let loadState :: LoadState
loadState = LoadState { findModuleCache :: Map (ModName, [FilePath]) ModulePath
findModuleCache = Map (ModName, [FilePath]) ModulePath
forall a. Monoid a => a
mempty
                               , fingerprints :: Map CacheModulePath FullFingerprint
fingerprints = Map CacheModulePath FullFingerprint
forall a. Monoid a => a
mempty
                               , scanned :: Map ModulePath ScanStatus
scanned = Map ModulePath ScanStatus
forall a. Monoid a => a
mempty
                               }
     (Either ModuleError a
result, LoadState
s) <- StateT LoadState ModuleM (Either ModuleError a)
-> LoadState -> ModuleT IO (Either ModuleError a, LoadState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT ModuleError (StateT LoadState ModuleM) a
-> StateT LoadState ModuleM (Either ModuleError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadConfig -> ExceptT ModuleError (StateT LoadState ModuleM) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
m LoadConfig
loadCfg)) LoadState
loadState
     (Map CacheModulePath FullFingerprint, Map ModulePath ScanStatus,
 Either ModuleError a)
-> ModuleM
     (Map CacheModulePath FullFingerprint, Map ModulePath ScanStatus,
      Either ModuleError a)
forall a. a -> ModuleT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadState -> Map CacheModulePath FullFingerprint
fingerprints LoadState
s, LoadState -> Map ModulePath ScanStatus
scanned LoadState
s, Either ModuleError a
result)

addFingerprint :: ModulePath -> FullFingerprint -> LoadM any ()
addFingerprint :: forall any. ModulePath -> FullFingerprint -> LoadM any ()
addFingerprint ModulePath
mpath FullFingerprint
fp =
  ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
-> LoadM any ()
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM
    ((LoadState -> LoadState)
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \LoadState
ls -> LoadState
ls { fingerprints = Map.insert (toCacheModulePath mpath) fp (fingerprints ls) })


-- | Add information about the status of a module path.
addScanned :: ModulePath -> ScanStatus -> LoadM any ScanStatus
addScanned :: forall any. ModulePath -> ScanStatus -> LoadM any ScanStatus
addScanned ModulePath
mpath ScanStatus
status =
  do ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
-> LoadM any ()
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM
       ((LoadState -> LoadState)
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' \LoadState
ls -> LoadState
ls { scanned = Map.insert mpath status (scanned ls) })
     ScanStatus -> LoadM any ScanStatus
forall a. a -> LoadM any a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScanStatus
status


-- | Get a label for the given module path.
-- Typically used for output.
getModulePathLabel :: ModulePath -> LoadM any String
getModulePathLabel :: forall any. ModulePath -> LoadM any FilePath
getModulePathLabel ModulePath
mpath =
  case ModulePath
mpath of
    InFile FilePath
p  -> ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  FilePath
-> LoadM any FilePath
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ((LoadConfig -> FilePath)
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((FilePath -> ShowS
`makeRelative` FilePath
p) ShowS -> (LoadConfig -> FilePath) -> LoadConfig -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadConfig -> FilePath
canonRoot))
    InMem FilePath
l ByteString
_ -> FilePath -> LoadM any FilePath
forall a. a -> LoadM any a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
l


-- | Get the fingerprint for the given module path.
getCachedFingerprint :: ModulePath -> LoadM any (Maybe FullFingerprint)
getCachedFingerprint :: forall any. ModulePath -> LoadM any (Maybe FullFingerprint)
getCachedFingerprint ModulePath
mpath =
  ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Maybe FullFingerprint)
-> LoadM any (Maybe FullFingerprint)
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ((LoadConfig -> Maybe FullFingerprint)
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Maybe FullFingerprint)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((CacheEntry -> FullFingerprint)
-> Maybe CacheEntry -> Maybe FullFingerprint
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CacheEntry -> FullFingerprint
cacheFingerprint (Maybe CacheEntry -> Maybe FullFingerprint)
-> (LoadConfig -> Maybe CacheEntry)
-> LoadConfig
-> Maybe FullFingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheModulePath
-> Map CacheModulePath CacheEntry -> Maybe CacheEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModulePath -> CacheModulePath
toCacheModulePath ModulePath
mpath) (Map CacheModulePath CacheEntry -> Maybe CacheEntry)
-> (LoadConfig -> Map CacheModulePath CacheEntry)
-> LoadConfig
-> Maybe CacheEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadCache -> Map CacheModulePath CacheEntry
cacheModules (LoadCache -> Map CacheModulePath CacheEntry)
-> (LoadConfig -> LoadCache)
-> LoadConfig
-> Map CacheModulePath CacheEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadConfig -> LoadCache
loadCache))


-- | Module path for the given import
findModule' :: ImportSource -> LoadM Err ModulePath
findModule' :: ImportSource -> LoadM Err ModulePath
findModule' ImportSource
isrc =
  do LoadState
ls <- ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadState
-> LoadM Err LoadState
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  LoadState
forall s (m :: * -> *). MonadState s m => m s
get
     let mname :: ModName
mname = ModName -> ModName
modNameToNormalModName (ImportSource -> ModName
importedModule ImportSource
isrc)
     [FilePath]
searchPath <- ModuleM [FilePath] -> LoadM Err [FilePath]
forall a. ModuleM a -> LoadM Err a
doModule ModuleM [FilePath]
M.getSearchPath
     case (ModName, [FilePath])
-> Map (ModName, [FilePath]) ModulePath -> Maybe ModulePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModName
mname, [FilePath]
searchPath) (LoadState -> Map (ModName, [FilePath]) ModulePath
findModuleCache LoadState
ls) of
       Just ModulePath
mpath -> ModulePath -> LoadM Err ModulePath
forall a. a -> LoadM Err a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModulePath
mpath
       Maybe ModulePath
Nothing ->
         do ModulePath
modLoc <- ModuleM ModulePath -> LoadM Err ModulePath
forall a. ModuleM a -> LoadM Err a
doModule (ModName -> ModuleM ModulePath
findModule ModName
mname)
            ModulePath
mpath  <- case ModulePath
modLoc of
                        InFile FilePath
path -> FilePath -> ModulePath
InFile (FilePath -> ModulePath)
-> LoadM Err FilePath -> LoadM Err ModulePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> LoadM Err FilePath
forall a. IO a -> LoadM Err a
doIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
                        InMem FilePath
l ByteString
c   -> ModulePath -> LoadM Err ModulePath
forall a. a -> LoadM Err a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> ByteString -> ModulePath
InMem FilePath
l ByteString
c)
            ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
-> LoadM Err ()
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM (ReaderT
   LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
 -> LoadM Err ())
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
-> LoadM Err ()
forall a b. (a -> b) -> a -> b
$ LoadState
-> ReaderT
     LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put LoadState
ls { findModuleCache = Map.insert (mname, searchPath)
                                                  mpath (findModuleCache ls) }
            ModulePath -> LoadM Err ModulePath
forall a. a -> LoadM Err a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModulePath
mpath

-- | Check if the given file has beein processed.
getStatus :: ModulePath -> LoadM any (Maybe ScanStatus)
getStatus :: forall any. ModulePath -> LoadM any (Maybe ScanStatus)
getStatus ModulePath
mpath = ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Maybe ScanStatus)
-> LoadM any (Maybe ScanStatus)
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ((LoadState -> Maybe ScanStatus)
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Maybe ScanStatus)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ModulePath -> Map ModulePath ScanStatus -> Maybe ScanStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModulePath
mpath (Map ModulePath ScanStatus -> Maybe ScanStatus)
-> (LoadState -> Map ModulePath ScanStatus)
-> LoadState
-> Maybe ScanStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadState -> Map ModulePath ScanStatus
scanned))

-- | Get the fingerpint for the ginve path, if any.
getFingerprint :: ModulePath -> LoadM any (Maybe FullFingerprint)
getFingerprint :: forall any. ModulePath -> LoadM any (Maybe FullFingerprint)
getFingerprint ModulePath
mpath = ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Maybe FullFingerprint)
-> LoadM any (Maybe FullFingerprint)
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ((LoadState -> Maybe FullFingerprint)
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Maybe FullFingerprint)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (CacheModulePath
-> Map CacheModulePath FullFingerprint -> Maybe FullFingerprint
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModulePath -> CacheModulePath
toCacheModulePath ModulePath
mpath) (Map CacheModulePath FullFingerprint -> Maybe FullFingerprint)
-> (LoadState -> Map CacheModulePath FullFingerprint)
-> LoadState
-> Maybe FullFingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadState -> Map CacheModulePath FullFingerprint
fingerprints))

getOldDocstringResults :: LoadM any (Map CacheModulePath (Maybe Bool))
getOldDocstringResults :: forall any. LoadM any (Map CacheModulePath (Maybe Bool))
getOldDocstringResults =
  ReaderT
  LoadConfig
  (ExceptT ModuleError (StateT LoadState ModuleM))
  (Map CacheModulePath (Maybe Bool))
-> LoadM any (Map CacheModulePath (Maybe Bool))
forall err a.
ReaderT
  LoadConfig (ExceptT ModuleError (StateT LoadState ModuleM)) a
-> LoadM err a
LoadM ((LoadConfig -> Map CacheModulePath (Maybe Bool))
-> ReaderT
     LoadConfig
     (ExceptT ModuleError (StateT LoadState ModuleM))
     (Map CacheModulePath (Maybe Bool))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((CacheEntry -> Maybe Bool)
-> Map CacheModulePath CacheEntry
-> Map CacheModulePath (Maybe Bool)
forall a b.
(a -> b) -> Map CacheModulePath a -> Map CacheModulePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CacheEntry -> Maybe Bool
cacheDocstringResult (Map CacheModulePath CacheEntry
 -> Map CacheModulePath (Maybe Bool))
-> (LoadConfig -> Map CacheModulePath CacheEntry)
-> LoadConfig
-> Map CacheModulePath (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadCache -> Map CacheModulePath CacheEntry
cacheModules (LoadCache -> Map CacheModulePath CacheEntry)
-> (LoadConfig -> LoadCache)
-> LoadConfig
-> Map CacheModulePath CacheEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadConfig -> LoadCache
loadCache))