{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Futhark.Compiler.Program
( readLibrary,
readUntypedLibrary,
Imports,
FileModule (..),
E.Warnings,
ProgramError (..),
LoadedProg (lpNameSource),
noLoadedProg,
lpImports,
reloadProg,
extendProg,
)
where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
( MVar,
modifyMVar,
newEmptyMVar,
newMVar,
putMVar,
readMVar,
)
import Control.Monad
import Control.Monad.Except
import Control.Monad.State (execStateT, gets, modify)
import Data.Bifunctor (first)
import Data.List (intercalate, isPrefixOf, sort)
import qualified Data.List.NonEmpty as NE
import Data.Loc (Loc (..), locOf)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time.Clock (UTCTime)
import Futhark.FreshNames
import Futhark.Util (interactWithFileSafely, nubOrd, startupTime)
import Futhark.Util.Pretty (Doc, line, ppr, text, (</>))
import qualified Language.Futhark as E
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
import Language.Futhark.Prelude
import Language.Futhark.Semantic
import qualified Language.Futhark.TypeChecker as E
import Language.Futhark.Warnings
import System.Directory (getModificationTime)
import System.FilePath (normalise)
import qualified System.FilePath.Posix as Posix
data LoadedFile fm = LoadedFile
{ LoadedFile fm -> FilePath
lfPath :: FilePath,
LoadedFile fm -> ImportName
lfImportName :: ImportName,
LoadedFile fm -> fm
lfMod :: fm,
LoadedFile fm -> UTCTime
lfModTime :: UTCTime
}
deriving (LoadedFile fm -> LoadedFile fm -> Bool
(LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool) -> Eq (LoadedFile fm)
forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadedFile fm -> LoadedFile fm -> Bool
$c/= :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
== :: LoadedFile fm -> LoadedFile fm -> Bool
$c== :: forall fm. Eq fm => LoadedFile fm -> LoadedFile fm -> Bool
Eq, Eq (LoadedFile fm)
Eq (LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> Ordering)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> Bool)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> (LoadedFile fm -> LoadedFile fm -> LoadedFile fm)
-> Ord (LoadedFile fm)
LoadedFile fm -> LoadedFile fm -> Bool
LoadedFile fm -> LoadedFile fm -> Ordering
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall fm. Ord fm => Eq (LoadedFile fm)
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
min :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmin :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
max :: LoadedFile fm -> LoadedFile fm -> LoadedFile fm
$cmax :: forall fm.
Ord fm =>
LoadedFile fm -> LoadedFile fm -> LoadedFile fm
>= :: LoadedFile fm -> LoadedFile fm -> Bool
$c>= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
> :: LoadedFile fm -> LoadedFile fm -> Bool
$c> :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
<= :: LoadedFile fm -> LoadedFile fm -> Bool
$c<= :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
< :: LoadedFile fm -> LoadedFile fm -> Bool
$c< :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Bool
compare :: LoadedFile fm -> LoadedFile fm -> Ordering
$ccompare :: forall fm. Ord fm => LoadedFile fm -> LoadedFile fm -> Ordering
$cp1Ord :: forall fm. Ord fm => Eq (LoadedFile fm)
Ord, Int -> LoadedFile fm -> ShowS
[LoadedFile fm] -> ShowS
LoadedFile fm -> FilePath
(Int -> LoadedFile fm -> ShowS)
-> (LoadedFile fm -> FilePath)
-> ([LoadedFile fm] -> ShowS)
-> Show (LoadedFile fm)
forall fm. Show fm => Int -> LoadedFile fm -> ShowS
forall fm. Show fm => [LoadedFile fm] -> ShowS
forall fm. Show fm => LoadedFile fm -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LoadedFile fm] -> ShowS
$cshowList :: forall fm. Show fm => [LoadedFile fm] -> ShowS
show :: LoadedFile fm -> FilePath
$cshow :: forall fm. Show fm => LoadedFile fm -> FilePath
showsPrec :: Int -> LoadedFile fm -> ShowS
$cshowsPrec :: forall fm. Show fm => Int -> LoadedFile fm -> ShowS
Show)
data ProgramError = ProgramError Loc Doc
type WithErrors = Either (NE.NonEmpty ProgramError)
newtype UncheckedImport = UncheckedImport
{ UncheckedImport
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked ::
WithErrors (LoadedFile E.UncheckedProg, [(ImportName, MVar UncheckedImport)])
}
type ReaderState = MVar (M.Map ImportName (Maybe (MVar UncheckedImport)))
newState :: [ImportName] -> IO ReaderState
newState :: [ImportName] -> IO ReaderState
newState [ImportName]
known = Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState
forall a. a -> IO (MVar a)
newMVar (Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState)
-> Map ImportName (Maybe (MVar UncheckedImport)) -> IO ReaderState
forall a b. (a -> b) -> a -> b
$ [(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport)))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> Map ImportName (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ [ImportName]
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
known ([Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))])
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. (a -> b) -> a -> b
$ Maybe (MVar UncheckedImport) -> [Maybe (MVar UncheckedImport)]
forall a. a -> [a]
repeat Maybe (MVar UncheckedImport)
forall a. Maybe a
Nothing
singleError :: ProgramError -> NE.NonEmpty ProgramError
singleError :: ProgramError -> NonEmpty ProgramError
singleError = (ProgramError -> [ProgramError] -> NonEmpty ProgramError
forall a. a -> [a] -> NonEmpty a
NE.:| [])
orderedImports ::
[(ImportName, MVar UncheckedImport)] ->
IO [(ImportName, WithErrors (LoadedFile E.UncheckedProg))]
orderedImports :: [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports = ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. [a] -> [a]
reverse (IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> ([(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> StateT
[(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT [] (StateT [(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> ([(ImportName, MVar UncheckedImport)]
-> StateT
[(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ())
-> [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ImportName, MVar UncheckedImport)
-> StateT
[(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ())
-> [(ImportName, MVar UncheckedImport)]
-> StateT
[(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName]
-> (ImportName, MVar UncheckedImport)
-> StateT
[(ImportName, WithErrors (LoadedFile UncheckedProg))] IO ()
forall (m :: * -> *).
(MonadIO m,
MonadState
[(ImportName, WithErrors (LoadedFile UncheckedProg))] m) =>
[ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk [])
where
spelunk :: [ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk [ImportName]
steps (ImportName
include, MVar UncheckedImport
mvar)
| ImportName
include ImportName -> [ImportName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ImportName]
steps = do
let problem :: ProgramError
problem =
Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError)
-> (FilePath -> Doc) -> FilePath -> ProgramError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Doc
text (FilePath -> ProgramError) -> FilePath -> ProgramError
forall a b. (a -> b) -> a -> b
$
FilePath
"Import cycle: "
FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate
FilePath
" -> "
((ImportName -> FilePath) -> [ImportName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ImportName -> FilePath
includeToString ([ImportName] -> [FilePath]) -> [ImportName] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [ImportName] -> [ImportName]
forall a. [a] -> [a]
reverse ([ImportName] -> [ImportName]) -> [ImportName] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ ImportName
include ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps)
([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, NonEmpty ProgramError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left (ProgramError -> NonEmpty ProgramError
singleError ProgramError
problem)) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = do
Maybe (WithErrors (LoadedFile UncheckedProg))
prev <- ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Maybe (WithErrors (LoadedFile UncheckedProg)))
-> m (Maybe (WithErrors (LoadedFile UncheckedProg)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Maybe (WithErrors (LoadedFile UncheckedProg)))
-> m (Maybe (WithErrors (LoadedFile UncheckedProg))))
-> ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Maybe (WithErrors (LoadedFile UncheckedProg)))
-> m (Maybe (WithErrors (LoadedFile UncheckedProg)))
forall a b. (a -> b) -> a -> b
$ ImportName
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Maybe (WithErrors (LoadedFile UncheckedProg))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ImportName
include
case Maybe (WithErrors (LoadedFile UncheckedProg))
prev of
Just WithErrors (LoadedFile UncheckedProg)
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (WithErrors (LoadedFile UncheckedProg))
Nothing -> do
WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
res <- UncheckedImport
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
unChecked (UncheckedImport
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> m UncheckedImport
-> m (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UncheckedImport -> m UncheckedImport
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVar UncheckedImport -> IO UncheckedImport
forall a. MVar a -> IO a
readMVar MVar UncheckedImport
mvar)
case WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
res of
Left NonEmpty ProgramError
errors ->
([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, NonEmpty ProgramError -> WithErrors (LoadedFile UncheckedProg)
forall a b. a -> Either a b
Left NonEmpty ProgramError
errors) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)
Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
more_imports) -> do
((ImportName, MVar UncheckedImport) -> m ())
-> [(ImportName, MVar UncheckedImport)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ImportName] -> (ImportName, MVar UncheckedImport) -> m ()
spelunk (ImportName
include ImportName -> [ImportName] -> [ImportName]
forall a. a -> [a] -> [a]
: [ImportName]
steps)) [(ImportName, MVar UncheckedImport)]
more_imports
([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))])
-> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ImportName
include, LoadedFile UncheckedProg -> WithErrors (LoadedFile UncheckedProg)
forall a b. b -> Either a b
Right LoadedFile UncheckedProg
file) (ImportName, WithErrors (LoadedFile UncheckedProg))
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
forall a. a -> [a] -> [a]
:)
errorsToTop ::
[(ImportName, WithErrors (LoadedFile E.UncheckedProg))] ->
WithErrors [(ImportName, LoadedFile E.UncheckedProg)]
errorsToTop :: [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [] = [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. b -> Either a b
Right []
errorsToTop ((ImportName
_, Left NonEmpty ProgramError
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
(NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> ([(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> (NonEmpty ProgramError -> NonEmpty ProgramError)
-> NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty ProgramError
x NonEmpty ProgramError
-> NonEmpty ProgramError -> NonEmpty ProgramError
forall a. Semigroup a => a -> a -> a
<>)) (WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> b -> a
const (NonEmpty ProgramError
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall a b. a -> Either a b
Left NonEmpty ProgramError
x)) ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest)
errorsToTop ((ImportName
name, Right LoadedFile UncheckedProg
x) : [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest) =
([(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImportName
name, LoadedFile UncheckedProg
x) (ImportName, LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [(ImportName, LoadedFile UncheckedProg)]
forall a. a -> [a] -> [a]
:) ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop [(ImportName, WithErrors (LoadedFile UncheckedProg))]
rest)
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar :: IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar IO UncheckedImport
m = do
MVar UncheckedImport
mvar <- IO (MVar UncheckedImport)
forall a. IO (MVar a)
newEmptyMVar
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> UncheckedImport -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar UncheckedImport
mvar (UncheckedImport -> IO ()) -> IO UncheckedImport -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UncheckedImport
m
Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MVar UncheckedImport) -> IO (Maybe (MVar UncheckedImport)))
-> Maybe (MVar UncheckedImport)
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ MVar UncheckedImport -> Maybe (MVar UncheckedImport)
forall a. a -> Maybe a
Just MVar UncheckedImport
mvar
contentsAndModTime :: FilePath -> IO (Maybe (Either String (T.Text, UTCTime)))
contentsAndModTime :: FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath =
IO (Text, UTCTime) -> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (IO (Text, UTCTime)
-> IO (Maybe (Either FilePath (Text, UTCTime))))
-> IO (Text, UTCTime)
-> IO (Maybe (Either FilePath (Text, UTCTime)))
forall a b. (a -> b) -> a -> b
$
(,) (Text -> UTCTime -> (Text, UTCTime))
-> IO Text -> IO (UTCTime -> (Text, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
T.readFile FilePath
filepath IO (UTCTime -> (Text, UTCTime)) -> IO UTCTime -> IO (Text, UTCTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO UTCTime
getModificationTime FilePath
filepath
readImportFile :: ImportName -> IO (Either ProgramError (LoadedFile T.Text))
readImportFile :: ImportName -> IO (Either ProgramError (LoadedFile Text))
readImportFile ImportName
include = do
let filepath :: FilePath
filepath = ImportName -> FilePath
includeToFilePath ImportName
include
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
filepath
case (Maybe (Either FilePath (Text, UTCTime))
r, FilePath -> [(FilePath, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
prelude_str [(FilePath, Text)]
prelude) of
(Just (Right (Text
s, UTCTime
mod_time)), Maybe Text
_) ->
Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgramError (LoadedFile Text))
-> LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> UTCTime -> LoadedFile Text
forall fm. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
filepath Text
s UTCTime
mod_time
(Just (Left FilePath
e), Maybe Text
_) ->
Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgramError -> Either ProgramError (LoadedFile Text))
-> ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
e
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Just Text
s) ->
Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. b -> Either a b
Right (LoadedFile Text -> Either ProgramError (LoadedFile Text))
-> LoadedFile Text -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> UTCTime -> LoadedFile Text
forall fm. FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
prelude_str Text
s UTCTime
startupTime
(Maybe (Either FilePath (Text, UTCTime))
Nothing, Maybe Text
Nothing) ->
Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text)))
-> Either ProgramError (LoadedFile Text)
-> IO (Either ProgramError (LoadedFile Text))
forall a b. (a -> b) -> a -> b
$ ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. a -> Either a b
Left (ProgramError -> Either ProgramError (LoadedFile Text))
-> ProgramError -> Either ProgramError (LoadedFile Text)
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError (ImportName -> Loc
forall a. Located a => a -> Loc
locOf ImportName
include) (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
not_found
where
prelude_str :: FilePath
prelude_str = FilePath
"/" FilePath -> ShowS
Posix.</> ImportName -> FilePath
includeToString ImportName
include FilePath -> ShowS
Posix.<.> FilePath
"fut"
loaded :: FilePath -> fm -> UTCTime -> LoadedFile fm
loaded FilePath
path fm
s UTCTime
mod_time =
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfImportName :: ImportName
lfImportName = ImportName
include,
lfPath :: FilePath
lfPath = FilePath
path,
lfMod :: fm
lfMod = fm
s,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time
}
not_found :: FilePath
not_found =
FilePath
"Could not find import " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
E.quote (ImportName -> FilePath
includeToString ImportName
include) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
handleFile ::
ReaderState -> LoadedFile T.Text -> IO UncheckedImport
handleFile :: ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile FilePath
file_name ImportName
import_name Text
file_contents UTCTime
mod_time) = do
case FilePath -> Text -> Either SyntaxError UncheckedProg
parseFuthark FilePath
file_name Text
file_contents of
Left (SyntaxError Loc
loc FilePath
err) ->
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> (ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ Loc -> Doc -> ProgramError
ProgramError Loc
loc (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text FilePath
err
Right UncheckedProg
prog -> do
let imports :: [ImportName]
imports = ((FilePath, SrcLoc) -> ImportName)
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> SrcLoc -> ImportName)
-> (FilePath, SrcLoc) -> ImportName
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom ImportName
import_name)) ([(FilePath, SrcLoc)] -> [ImportName])
-> [(FilePath, SrcLoc)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ UncheckedProg -> [(FilePath, SrcLoc)]
forall (f :: * -> *) vn. ProgBase f vn -> [(FilePath, SrcLoc)]
E.progImports UncheckedProg
prog
[(ImportName, MVar UncheckedImport)]
mvars <-
((ImportName, Maybe (MVar UncheckedImport))
-> Maybe (ImportName, MVar UncheckedImport))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe (MVar UncheckedImport))
-> Maybe (ImportName, MVar UncheckedImport)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)])
-> ([Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))])
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, MVar UncheckedImport)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> [Maybe (MVar UncheckedImport)]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ImportName]
imports
([Maybe (MVar UncheckedImport)]
-> [(ImportName, MVar UncheckedImport)])
-> IO [Maybe (MVar UncheckedImport)]
-> IO [(ImportName, MVar UncheckedImport)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImportName -> IO (Maybe (MVar UncheckedImport)))
-> [ImportName] -> IO [Maybe (MVar UncheckedImport)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar) [ImportName]
imports
let file :: LoadedFile UncheckedProg
file =
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfPath :: FilePath
lfPath = FilePath
file_name,
lfImportName :: ImportName
lfImportName = ImportName
import_name,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
lfMod :: UncheckedProg
lfMod = UncheckedProg
prog
}
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ (LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. b -> Either a b
Right (LoadedFile UncheckedProg
file, [(ImportName, MVar UncheckedImport)]
mvars)
readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport :: ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
include =
ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state ->
case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
Just Maybe (MVar UncheckedImport)
x -> (Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
x)
Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
ImportName -> IO (Either ProgramError (LoadedFile Text))
readImportFile ImportName
include IO (Either ProgramError (LoadedFile Text))
-> (Either ProgramError (LoadedFile Text) -> IO UncheckedImport)
-> IO UncheckedImport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ProgramError
e -> UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> UncheckedImport -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$ WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
forall a b. (a -> b) -> a -> b
$ NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. (a -> b) -> a -> b
$ ProgramError -> NonEmpty ProgramError
singleError ProgramError
e
Right LoadedFile Text
file -> ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar LoadedFile Text
file
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
Maybe (MVar UncheckedImport))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, Maybe (MVar UncheckedImport)
prog_mvar)
readUntypedLibraryExceptKnown ::
[ImportName] ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgramError) [LoadedFile E.UncheckedProg])
readUntypedLibraryExceptKnown :: [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [ImportName]
known [FilePath]
fps = do
ReaderState
state_mvar <- IO ReaderState -> IO ReaderState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReaderState -> IO ReaderState)
-> IO ReaderState -> IO ReaderState
forall a b. (a -> b) -> a -> b
$ [ImportName] -> IO ReaderState
newState [ImportName]
known
let prelude_import :: ImportName
prelude_import = FilePath -> ImportName
mkInitialImport FilePath
"/prelude/prelude"
Maybe (MVar UncheckedImport)
prelude_mvar <- IO (Maybe (MVar UncheckedImport))
-> IO (Maybe (MVar UncheckedImport))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (MVar UncheckedImport))
-> IO (Maybe (MVar UncheckedImport)))
-> IO (Maybe (MVar UncheckedImport))
-> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ ReaderState -> ImportName -> IO (Maybe (MVar UncheckedImport))
readImport ReaderState
state_mvar ImportName
prelude_import
[(ImportName, Maybe (MVar UncheckedImport))]
fps_mvars <- IO [(ImportName, Maybe (MVar UncheckedImport))]
-> IO [(ImportName, Maybe (MVar UncheckedImport))]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO (ImportName, Maybe (MVar UncheckedImport)))
-> [FilePath] -> IO [(ImportName, Maybe (MVar UncheckedImport))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar) [FilePath]
fps)
let unknown_mvars :: [(ImportName, MVar UncheckedImport)]
unknown_mvars = [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, MVar UncheckedImport)]
forall a. [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown ((ImportName
prelude_import, Maybe (MVar UncheckedImport)
prelude_mvar) (ImportName, Maybe (MVar UncheckedImport))
-> [(ImportName, Maybe (MVar UncheckedImport))]
-> [(ImportName, Maybe (MVar UncheckedImport))]
forall a. a -> [a] -> [a]
: [(ImportName, Maybe (MVar UncheckedImport))]
fps_mvars)
([(ImportName, LoadedFile UncheckedProg)]
-> [LoadedFile UncheckedProg])
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ImportName, LoadedFile UncheckedProg)
-> LoadedFile UncheckedProg)
-> [(ImportName, LoadedFile UncheckedProg)]
-> [LoadedFile UncheckedProg]
forall a b. (a -> b) -> [a] -> [b]
map (ImportName, LoadedFile UncheckedProg) -> LoadedFile UncheckedProg
forall a b. (a, b) -> b
snd) (WithErrors [(ImportName, LoadedFile UncheckedProg)]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)])
-> [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> WithErrors [(ImportName, LoadedFile UncheckedProg)]
errorsToTop ([(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ImportName, MVar UncheckedImport)]
-> IO [(ImportName, WithErrors (LoadedFile UncheckedProg))]
orderedImports [(ImportName, MVar UncheckedImport)]
unknown_mvars
where
onlyUnknown :: [(ImportName, Maybe a)] -> [(ImportName, a)]
onlyUnknown = ((ImportName, Maybe a) -> Maybe (ImportName, a))
-> [(ImportName, Maybe a)] -> [(ImportName, a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ImportName, Maybe a) -> Maybe (ImportName, a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
onFile :: ReaderState
-> FilePath -> IO (ImportName, Maybe (MVar UncheckedImport))
onFile ReaderState
state_mvar FilePath
fp =
ReaderState
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar ReaderState
state_mvar ((Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport)))
-> (Map ImportName (Maybe (MVar UncheckedImport))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport))))
-> IO (ImportName, Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ \Map ImportName (Maybe (MVar UncheckedImport))
state -> do
case ImportName
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Maybe (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ImportName
include Map ImportName (Maybe (MVar UncheckedImport))
state of
Just Maybe (MVar UncheckedImport)
prog_mvar -> (Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
Maybe (Maybe (MVar UncheckedImport))
Nothing -> do
Maybe (MVar UncheckedImport)
prog_mvar <- IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
newImportMVar (IO UncheckedImport -> IO (Maybe (MVar UncheckedImport)))
-> IO UncheckedImport -> IO (Maybe (MVar UncheckedImport))
forall a b. (a -> b) -> a -> b
$ do
Maybe (Either FilePath (Text, UTCTime))
r <- FilePath -> IO (Maybe (Either FilePath (Text, UTCTime)))
contentsAndModTime FilePath
fp
case Maybe (Either FilePath (Text, UTCTime))
r of
Just (Right (Text
fs, UTCTime
mod_time)) -> do
ReaderState -> LoadedFile Text -> IO UncheckedImport
handleFile ReaderState
state_mvar (LoadedFile Text -> IO UncheckedImport)
-> LoadedFile Text -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
LoadedFile :: forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile
{ lfImportName :: ImportName
lfImportName = ImportName
include,
lfMod :: Text
lfMod = Text
fs,
lfModTime :: UTCTime
lfModTime = UTCTime
mod_time,
lfPath :: FilePath
lfPath = FilePath
fp
}
Just (Left FilePath
e) ->
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> (ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
Loc -> Doc -> ProgramError
ProgramError Loc
NoLoc (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> FilePath
show FilePath
e
Maybe (Either FilePath (Text, UTCTime))
Nothing ->
UncheckedImport -> IO UncheckedImport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UncheckedImport -> IO UncheckedImport)
-> (ProgramError -> UncheckedImport)
-> ProgramError
-> IO UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport
UncheckedImport (WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
-> UncheckedImport)
-> (ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> ProgramError
-> UncheckedImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)]))
-> (ProgramError -> NonEmpty ProgramError)
-> ProgramError
-> WithErrors
(LoadedFile UncheckedProg, [(ImportName, MVar UncheckedImport)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> IO UncheckedImport)
-> ProgramError -> IO UncheckedImport
forall a b. (a -> b) -> a -> b
$
Loc -> Doc -> ProgramError
ProgramError Loc
NoLoc (Doc -> ProgramError) -> Doc -> ProgramError
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
": file not found."
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
-> IO
(Map ImportName (Maybe (MVar UncheckedImport)),
(ImportName, Maybe (MVar UncheckedImport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ImportName
-> Maybe (MVar UncheckedImport)
-> Map ImportName (Maybe (MVar UncheckedImport))
-> Map ImportName (Maybe (MVar UncheckedImport))
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ImportName
include Maybe (MVar UncheckedImport)
prog_mvar Map ImportName (Maybe (MVar UncheckedImport))
state, (ImportName
include, Maybe (MVar UncheckedImport)
prog_mvar))
where
include :: ImportName
include = FilePath -> ImportName
mkInitialImport FilePath
fp_name
(FilePath
fp_name, FilePath
_) = FilePath -> (FilePath, FilePath)
Posix.splitExtension FilePath
fp
asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports :: [LoadedFile (VNameSource, FileModule)] -> Imports
asImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f
where
f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)
typeCheckProg ::
[LoadedFile (VNameSource, FileModule)] ->
VNameSource ->
[LoadedFile E.UncheckedProg] ->
WithErrors (E.Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg :: [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
orig_imports VNameSource
orig_src =
((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> [LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
f (Warnings
forall a. Monoid a => a
mempty, [LoadedFile (VNameSource, FileModule)]
orig_imports, VNameSource
orig_src)
where
roots :: [FilePath]
roots = [FilePath
"/prelude/prelude"]
f :: (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> LoadedFile UncheckedProg
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
f (Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src) (LoadedFile FilePath
path ImportName
import_name UncheckedProg
prog UTCTime
mod_time) = do
let prog' :: UncheckedProg
prog'
| FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath ImportName
import_name = UncheckedProg
prog
| Bool
otherwise = [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots UncheckedProg
prog
case Imports
-> VNameSource
-> ImportName
-> UncheckedProg
-> (Warnings, Either TypeError (FileModule, VNameSource))
E.checkProg ([LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
imports) VNameSource
src ImportName
import_name UncheckedProg
prog' of
(Warnings
prog_ws, Left (E.TypeError Loc
loc Notes
notes Doc
msg)) -> do
let ws' :: Warnings
ws' = Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws
err' :: Doc
err' = Doc
msg Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Notes -> Doc
forall a. Pretty a => a -> Doc
ppr Notes
notes
NonEmpty ProgramError
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall a b. a -> Either a b
Left (NonEmpty ProgramError
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> (Doc -> NonEmpty ProgramError)
-> Doc
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramError -> NonEmpty ProgramError
singleError (ProgramError -> NonEmpty ProgramError)
-> (Doc -> ProgramError) -> Doc -> NonEmpty ProgramError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Doc -> ProgramError
ProgramError (Loc -> Loc
forall a. Located a => a -> Loc
locOf Loc
loc) (Doc
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> Doc
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall a b. (a -> b) -> a -> b
$
if Warnings -> Bool
anyWarnings Warnings
ws'
then Warnings -> Doc
forall a. Pretty a => a -> Doc
ppr Warnings
ws' Doc -> Doc -> Doc
</> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall a. Pretty a => a -> Doc
ppr Doc
err'
else Doc -> Doc
forall a. Pretty a => a -> Doc
ppr Doc
err'
(Warnings
prog_ws, Right (FileModule
m, VNameSource
src')) ->
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall a b. b -> Either a b
Right
( Warnings
ws Warnings -> Warnings -> Warnings
forall a. Semigroup a => a -> a -> a
<> Warnings
prog_ws,
[LoadedFile (VNameSource, FileModule)]
imports [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. [a] -> [a] -> [a]
++ [FilePath
-> ImportName
-> (VNameSource, FileModule)
-> UTCTime
-> LoadedFile (VNameSource, FileModule)
forall fm. FilePath -> ImportName -> fm -> UTCTime -> LoadedFile fm
LoadedFile FilePath
path ImportName
import_name (VNameSource
src, FileModule
m) UTCTime
mod_time],
VNameSource
src'
)
setEntryPoints ::
[E.Name] ->
[FilePath] ->
[LoadedFile E.UncheckedProg] ->
[LoadedFile E.UncheckedProg]
setEntryPoints :: [Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints [Name]
extra_eps [FilePath]
fps = (LoadedFile UncheckedProg -> LoadedFile UncheckedProg)
-> [LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile
where
fps' :: [FilePath]
fps' = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
normalise [FilePath]
fps
onFile :: LoadedFile UncheckedProg -> LoadedFile UncheckedProg
onFile LoadedFile UncheckedProg
lf
| ImportName -> FilePath
includeToFilePath (LoadedFile UncheckedProg -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile UncheckedProg
lf) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fps' =
LoadedFile UncheckedProg
lf {lfMod :: UncheckedProg
lfMod = UncheckedProg
prog {progDecs :: [DecBase NoInfo Name]
E.progDecs = (DecBase NoInfo Name -> DecBase NoInfo Name)
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map DecBase NoInfo Name -> DecBase NoInfo Name
onDec (UncheckedProg -> [DecBase NoInfo Name]
forall (f :: * -> *) vn. ProgBase f vn -> [DecBase f vn]
E.progDecs UncheckedProg
prog)}}
| Bool
otherwise =
LoadedFile UncheckedProg
lf
where
prog :: UncheckedProg
prog = LoadedFile UncheckedProg -> UncheckedProg
forall fm. LoadedFile fm -> fm
lfMod LoadedFile UncheckedProg
lf
onDec :: DecBase NoInfo Name -> DecBase NoInfo Name
onDec (E.ValDec ValBindBase NoInfo Name
vb)
| ValBindBase NoInfo Name -> Name
forall (f :: * -> *) vn. ValBindBase f vn -> vn
E.valBindName ValBindBase NoInfo Name
vb Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
extra_eps =
ValBindBase NoInfo Name -> DecBase NoInfo Name
forall (f :: * -> *) vn. ValBindBase f vn -> DecBase f vn
E.ValDec ValBindBase NoInfo Name
vb {valBindEntryPoint :: Maybe (NoInfo EntryPoint)
E.valBindEntryPoint = NoInfo EntryPoint -> Maybe (NoInfo EntryPoint)
forall a. a -> Maybe a
Just NoInfo EntryPoint
forall a. NoInfo a
E.NoInfo}
onDec DecBase NoInfo Name
dec = DecBase NoInfo Name
dec
prependRoots :: [FilePath] -> E.UncheckedProg -> E.UncheckedProg
prependRoots :: [FilePath] -> UncheckedProg -> UncheckedProg
prependRoots [FilePath]
roots (E.Prog Maybe DocComment
doc [DecBase NoInfo Name]
ds) =
Maybe DocComment -> [DecBase NoInfo Name] -> UncheckedProg
forall (f :: * -> *) vn.
Maybe DocComment -> [DecBase f vn] -> ProgBase f vn
E.Prog Maybe DocComment
doc ([DecBase NoInfo Name] -> UncheckedProg)
-> [DecBase NoInfo Name] -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ (FilePath -> DecBase NoInfo Name)
-> [FilePath] -> [DecBase NoInfo Name]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> DecBase NoInfo Name
forall vn. FilePath -> DecBase NoInfo vn
mkImport [FilePath]
roots [DecBase NoInfo Name]
-> [DecBase NoInfo Name] -> [DecBase NoInfo Name]
forall a. [a] -> [a] -> [a]
++ [DecBase NoInfo Name]
ds
where
mkImport :: FilePath -> DecBase NoInfo vn
mkImport FilePath
fp =
DecBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. DecBase f vn -> SrcLoc -> DecBase f vn
E.LocalDec (ModExpBase NoInfo vn -> SrcLoc -> DecBase NoInfo vn
forall (f :: * -> *) vn. ModExpBase f vn -> SrcLoc -> DecBase f vn
E.OpenDec (FilePath -> NoInfo FilePath -> SrcLoc -> ModExpBase NoInfo vn
forall (f :: * -> *) vn.
FilePath -> f FilePath -> SrcLoc -> ModExpBase f vn
E.ModImport FilePath
fp NoInfo FilePath
forall a. NoInfo a
E.NoInfo SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty) SrcLoc
forall a. Monoid a => a
mempty
data LoadedProg = LoadedProg
{ LoadedProg -> [FilePath]
lpRoots :: [FilePath],
LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles :: [LoadedFile (VNameSource, FileModule)],
LoadedProg -> VNameSource
lpNameSource :: VNameSource
}
lpImports :: LoadedProg -> Imports
lpImports :: LoadedProg -> Imports
lpImports = (LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule))
-> [LoadedFile (VNameSource, FileModule)] -> Imports
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> (FilePath, FileModule)
forall a b. LoadedFile (a, b) -> (FilePath, b)
f ([LoadedFile (VNameSource, FileModule)] -> Imports)
-> (LoadedProg -> [LoadedFile (VNameSource, FileModule)])
-> LoadedProg
-> Imports
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles
where
f :: LoadedFile (a, b) -> (FilePath, b)
f LoadedFile (a, b)
lf = (ImportName -> FilePath
includeToString (LoadedFile (a, b) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (a, b)
lf), (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> (a, b) -> b
forall a b. (a -> b) -> a -> b
$ LoadedFile (a, b) -> (a, b)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (a, b)
lf)
unchangedImports ::
MonadIO m =>
VNameSource ->
[LoadedFile (VNameSource, FileModule)] ->
m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports :: VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [] = ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], VNameSource
src)
unchangedImports VNameSource
src (LoadedFile (VNameSource, FileModule)
f : [LoadedFile (VNameSource, FileModule)]
fs)
| FilePath
"/prelude" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ImportName -> FilePath
includeToFilePath (LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile (VNameSource, FileModule)
f) =
([LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs
| Bool
otherwise = do
Bool
changed <-
Bool
-> (Either FilePath UTCTime -> Bool)
-> Maybe (Either FilePath UTCTime)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((FilePath -> Bool)
-> (UTCTime -> Bool) -> Either FilePath UTCTime -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> FilePath -> Bool
forall a b. a -> b -> a
const Bool
True) (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> LoadedFile (VNameSource, FileModule) -> UTCTime
forall fm. LoadedFile fm -> UTCTime
lfModTime LoadedFile (VNameSource, FileModule)
f))
(Maybe (Either FilePath UTCTime) -> Bool)
-> m (Maybe (Either FilePath UTCTime)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Either FilePath UTCTime))
-> m (Maybe (Either FilePath UTCTime))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> IO (Maybe (Either FilePath UTCTime))
forall a. IO a -> IO (Maybe (Either FilePath a))
interactWithFileSafely (FilePath -> IO UTCTime
getModificationTime (FilePath -> IO UTCTime) -> FilePath -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> FilePath
forall fm. LoadedFile fm -> FilePath
lfPath LoadedFile (VNameSource, FileModule)
f))
if Bool
changed
then ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (VNameSource, FileModule) -> VNameSource
forall a b. (a, b) -> a
fst ((VNameSource, FileModule) -> VNameSource)
-> (VNameSource, FileModule) -> VNameSource
forall a b. (a -> b) -> a -> b
$ LoadedFile (VNameSource, FileModule) -> (VNameSource, FileModule)
forall fm. LoadedFile fm -> fm
lfMod LoadedFile (VNameSource, FileModule)
f)
else ([LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)])
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (LoadedFile (VNameSource, FileModule)
f LoadedFile (VNameSource, FileModule)
-> [LoadedFile (VNameSource, FileModule)]
-> [LoadedFile (VNameSource, FileModule)]
forall a. a -> [a] -> [a]
:) (([LoadedFile (VNameSource, FileModule)], VNameSource)
-> ([LoadedFile (VNameSource, FileModule)], VNameSource))
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
fs
noLoadedProg :: LoadedProg
noLoadedProg :: LoadedProg
noLoadedProg =
LoadedProg :: [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg
{ lpRoots :: [FilePath]
lpRoots = [],
lpFiles :: [LoadedFile (VNameSource, FileModule)]
lpFiles = [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty,
lpNameSource :: VNameSource
lpNameSource = Int -> VNameSource
newNameSource (Int -> VNameSource) -> Int -> VNameSource
forall a b. (a -> b) -> a -> b
$ Int
E.maxIntrinsicTag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
}
usableLoadedProg :: MonadIO m => LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg :: LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg (LoadedProg [FilePath]
roots [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src) [FilePath]
new_roots
| [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
roots [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
new_roots = do
([LoadedFile (VNameSource, FileModule)]
imports', VNameSource
src') <- VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *).
MonadIO m =>
VNameSource
-> [LoadedFile (VNameSource, FileModule)]
-> m ([LoadedFile (VNameSource, FileModule)], VNameSource)
unchangedImports VNameSource
src [LoadedFile (VNameSource, FileModule)]
imports
LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadedProg -> m LoadedProg) -> LoadedProg -> m LoadedProg
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg [] [LoadedFile (VNameSource, FileModule)]
imports' VNameSource
src'
| Bool
otherwise =
LoadedProg -> m LoadedProg
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadedProg
noLoadedProg
extendProg ::
LoadedProg ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgramError) (E.Warnings, LoadedProg))
extendProg :: LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
extendProg LoadedProg
lp [FilePath]
new_roots = do
Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
new_imports_untyped <-
[ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown ((LoadedFile (VNameSource, FileModule) -> ImportName)
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile (VNameSource, FileModule) -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName ([LoadedFile (VNameSource, FileModule)] -> [ImportName])
-> [LoadedFile (VNameSource, FileModule)] -> [ImportName]
forall a b. (a -> b) -> a -> b
$ LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) [FilePath]
new_roots
Either (NonEmpty ProgramError) (Warnings, LoadedProg)
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (NonEmpty ProgramError) (Warnings, LoadedProg)
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg)))
-> Either (NonEmpty ProgramError) (Warnings, LoadedProg)
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
forall a b. (a -> b) -> a -> b
$ do
(Warnings
ws, [LoadedFile (VNameSource, FileModule)]
imports, VNameSource
src') <-
[LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg (LoadedProg -> [LoadedFile (VNameSource, FileModule)]
lpFiles LoadedProg
lp) (LoadedProg -> VNameSource
lpNameSource LoadedProg
lp) ([LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
new_imports_untyped
(Warnings, LoadedProg)
-> Either (NonEmpty ProgramError) (Warnings, LoadedProg)
forall a b. b -> Either a b
Right (Warnings
ws, [FilePath]
-> [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> LoadedProg
LoadedProg ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd (LoadedProg -> [FilePath]
lpRoots LoadedProg
lp [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
new_roots)) [LoadedFile (VNameSource, FileModule)]
imports VNameSource
src')
reloadProg ::
LoadedProg ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgramError) (E.Warnings, LoadedProg))
reloadProg :: LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
reloadProg LoadedProg
lp [FilePath]
new_roots = do
LoadedProg
lp' <- LoadedProg -> [FilePath] -> IO LoadedProg
forall (m :: * -> *).
MonadIO m =>
LoadedProg -> [FilePath] -> m LoadedProg
usableLoadedProg LoadedProg
lp [FilePath]
new_roots
LoadedProg
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) (Warnings, LoadedProg))
extendProg LoadedProg
lp' [FilePath]
new_roots
readLibrary ::
[E.Name] ->
[FilePath] ->
IO (Either (NE.NonEmpty ProgramError) (E.Warnings, Imports, VNameSource))
readLibrary :: [Name]
-> [FilePath]
-> IO
(Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
readLibrary [Name]
extra_eps [FilePath]
fps =
( ((Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> (Warnings, Imports, VNameSource))
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> (Warnings, Imports, VNameSource)
forall a c.
(a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob
(WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> ([LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource))
-> [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LoadedFile (VNameSource, FileModule)]
-> VNameSource
-> [LoadedFile UncheckedProg]
-> WithErrors
(Warnings, [LoadedFile (VNameSource, FileModule)], VNameSource)
typeCheckProg [LoadedFile (VNameSource, FileModule)]
forall a. Monoid a => a
mempty (LoadedProg -> VNameSource
lpNameSource LoadedProg
noLoadedProg)
([LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ([LoadedFile UncheckedProg] -> [LoadedFile UncheckedProg])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Name]
-> [FilePath]
-> [LoadedFile UncheckedProg]
-> [LoadedFile UncheckedProg]
setEntryPoints (Name
E.defaultEntryPoint Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
extra_eps) [FilePath]
fps)
)
(Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO
(Either (NonEmpty ProgramError) (Warnings, Imports, VNameSource))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown [] [FilePath]
fps
where
frob :: (a, [LoadedFile (VNameSource, FileModule)], c) -> (a, Imports, c)
frob (a
x, [LoadedFile (VNameSource, FileModule)]
y, c
z) = (a
x, [LoadedFile (VNameSource, FileModule)] -> Imports
asImports [LoadedFile (VNameSource, FileModule)]
y, c
z)
readUntypedLibrary ::
[FilePath] ->
IO (Either (NE.NonEmpty ProgramError) [(ImportName, E.UncheckedProg)])
readUntypedLibrary :: [FilePath]
-> IO
(Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
readUntypedLibrary = (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO
(Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)])
-> Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]
-> Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LoadedFile UncheckedProg -> (ImportName, UncheckedProg))
-> [LoadedFile UncheckedProg] -> [(ImportName, UncheckedProg)]
forall a b. (a -> b) -> [a] -> [b]
map LoadedFile UncheckedProg -> (ImportName, UncheckedProg)
forall b. LoadedFile b -> (ImportName, b)
f)) (IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
-> IO
(Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)]))
-> ([FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg]))
-> [FilePath]
-> IO
(Either (NonEmpty ProgramError) [(ImportName, UncheckedProg)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ImportName]
-> [FilePath]
-> IO (Either (NonEmpty ProgramError) [LoadedFile UncheckedProg])
readUntypedLibraryExceptKnown []
where
f :: LoadedFile b -> (ImportName, b)
f LoadedFile b
lf = (LoadedFile b -> ImportName
forall fm. LoadedFile fm -> ImportName
lfImportName LoadedFile b
lf, LoadedFile b -> b
forall fm. LoadedFile fm -> fm
lfMod LoadedFile b
lf)