{-# LANGUAGE OverloadedLists #-}
module Agda.Interaction.Library
( findProjectRoot
, getAgdaAppDir
, getDefaultLibraries
, getInstalledLibraries
, getTrustedExecutables
, libraryIncludePaths
, getAgdaLibFiles'
, getPrimitiveLibDir
, LibName
, OptionsPragma(..)
, AgdaLibFile(..)
, ExeName
, LibM
, mkLibM
, LibWarning(..)
, LibPositionInfo(..)
, libraryWarningName
, ProjectConfig(..)
, VersionView(..), versionView, unVersionView
, findLib'
) where
import Control.Arrow ( first , second )
import qualified Control.Exception as E
import Control.Monad ( filterM, forM )
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Writer ( Writer, runWriterT, tell )
import Control.Monad.IO.Class ( MonadIO(..) )
import Data.Char
import Data.Either
import Data.Function (on)
import Data.Map ( Map )
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Text as T
import System.Directory
import System.FilePath
import System.Environment
import Agda.Interaction.Library.Base
import Agda.Interaction.Library.Parse
import Agda.Utils.Environment
import Agda.Utils.FileName
import Agda.Utils.Functor ( (<&>) )
import Agda.Utils.IO ( catchIO )
import qualified Agda.Utils.IO.UTF8 as UTF8
import Agda.Utils.Lens
import Agda.Utils.List
import Agda.Utils.List1 ( List1, pattern (:|) )
import Agda.Utils.List2 ( List2 )
import qualified Agda.Utils.List1 as List1
import qualified Agda.Utils.List2 as List2
import Agda.Utils.Maybe
import Agda.Utils.Monad
import Agda.Syntax.Common.Pretty
import Agda.Utils.Singleton
import Agda.Utils.String ( trim )
import Agda.Utils.Tuple ( mapSndM )
import Agda.Version
import Paths_Agda ( getDataFileName )
data VersionView = VersionView
{ VersionView -> [Char]
vvBase :: LibName
, VersionView -> [Integer]
vvNumbers :: [Integer]
} deriving (VersionView -> VersionView -> Bool
(VersionView -> VersionView -> Bool)
-> (VersionView -> VersionView -> Bool) -> Eq VersionView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionView -> VersionView -> Bool
== :: VersionView -> VersionView -> Bool
$c/= :: VersionView -> VersionView -> Bool
/= :: VersionView -> VersionView -> Bool
Eq, LineNumber -> VersionView -> ShowS
[VersionView] -> ShowS
VersionView -> [Char]
(LineNumber -> VersionView -> ShowS)
-> (VersionView -> [Char])
-> ([VersionView] -> ShowS)
-> Show VersionView
forall a.
(LineNumber -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: LineNumber -> VersionView -> ShowS
showsPrec :: LineNumber -> VersionView -> ShowS
$cshow :: VersionView -> [Char]
show :: VersionView -> [Char]
$cshowList :: [VersionView] -> ShowS
showList :: [VersionView] -> ShowS
Show)
mkLibM :: [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM :: forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [AgdaLibFile]
libs LibErrorIO a
m = do
(a
x, LibErrWarns
ews) <- WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns)
-> ExceptT
Doc (WriterT [LibWarning] (StateT LibState IO)) (a, LibErrWarns)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Doc m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns)
-> ExceptT
Doc (WriterT [LibWarning] (StateT LibState IO)) (a, LibErrWarns))
-> WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns)
-> ExceptT
Doc (WriterT [LibWarning] (StateT LibState IO)) (a, LibErrWarns)
forall a b. (a -> b) -> a -> b
$ StateT LibState IO (a, LibErrWarns)
-> WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns)
forall (m :: * -> *) a. Monad m => m a -> WriterT [LibWarning] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT LibState IO (a, LibErrWarns)
-> WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns))
-> StateT LibState IO (a, LibErrWarns)
-> WriterT [LibWarning] (StateT LibState IO) (a, LibErrWarns)
forall a b. (a -> b) -> a -> b
$ LibErrorIO a -> StateT LibState IO (a, LibErrWarns)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT LibErrorIO a
m
let ([LibError]
errs, [LibWarning]
warns) = LibErrWarns -> ([LibError], [LibWarning])
forall a b. [Either a b] -> ([a], [b])
partitionEithers LibErrWarns
ews
[LibWarning]
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [LibWarning]
warns
Bool
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LibError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LibError]
errs) (ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ())
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
-> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
forall a b. (a -> b) -> a -> b
$ do
let doc :: Doc
doc = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (LibError -> Doc) -> [LibError] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([AgdaLibFile] -> LibError -> Doc
formatLibError [AgdaLibFile]
libs) [LibError]
errs
Doc -> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) ()
forall a.
Doc -> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Doc
doc
a -> LibM a
forall a.
a -> ExceptT Doc (WriterT [LibWarning] (StateT LibState IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
getAgdaAppDir :: IO FilePath
getAgdaAppDir :: IO [Char]
getAgdaAppDir = do
let agdaDir :: IO [Char]
agdaDir = [Char] -> IO [Char]
getAppUserDataDirectory [Char]
"agda" IO [Char] -> ([Char] -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
legacyAgdaDir ->
IO Bool -> IO [Char] -> IO [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist [Char]
legacyAgdaDir)
([Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
legacyAgdaDir)
(XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgConfig [Char]
"agda")
IO (Maybe [Char])
-> IO [Char] -> ([Char] -> IO [Char]) -> IO [Char]
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> m b -> (a -> m b) -> m b
caseMaybeM ([Char] -> IO (Maybe [Char])
lookupEnv [Char]
"AGDA_DIR") IO [Char]
agdaDir (([Char] -> IO [Char]) -> IO [Char])
-> ([Char] -> IO [Char]) -> IO [Char]
forall a b. (a -> b) -> a -> b
$ \ [Char]
dir ->
IO Bool -> IO [Char] -> IO [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist [Char]
dir) ([Char] -> IO [Char]
canonicalizePath [Char]
dir) (IO [Char] -> IO [Char]) -> IO [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ do
[Char]
d <- IO [Char]
agdaDir
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: Environment variable AGDA_DIR points to non-existing directory " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
dir [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", using " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" instead."
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
d
getPrimitiveLibDir :: IO FilePath
getPrimitiveLibDir :: IO [Char]
getPrimitiveLibDir = do
[Char]
libdir <- AbsolutePath -> [Char]
filePath (AbsolutePath -> [Char]) -> IO AbsolutePath -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO AbsolutePath
absolute ([Char] -> IO AbsolutePath) -> IO [Char] -> IO AbsolutePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO [Char]
getDataFileName [Char]
"lib")
IO Bool -> IO [Char] -> IO [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist [Char]
libdir)
([Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
libdir [Char] -> ShowS
</> [Char]
"prim")
([Char] -> IO [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"The lib directory " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
libdir [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist")
defaultLibraryFiles :: List1 FilePath
defaultLibraryFiles :: NonEmpty [Char]
defaultLibraryFiles = ([Char]
"libraries-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
version) [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
:| [Char]
"libraries" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: []
defaultsFile :: FilePath
defaultsFile :: [Char]
defaultsFile = [Char]
"defaults"
defaultExecutableFiles :: List1 FilePath
defaultExecutableFiles :: NonEmpty [Char]
defaultExecutableFiles = ([Char]
"executables-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
version) [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
:| [Char]
"executables" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: []
findProjectConfig
:: FilePath
-> LibM ProjectConfig
findProjectConfig :: [Char] -> LibM ProjectConfig
findProjectConfig [Char]
root = [AgdaLibFile] -> LibErrorIO ProjectConfig -> LibM ProjectConfig
forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [] (LibErrorIO ProjectConfig -> LibM ProjectConfig)
-> LibErrorIO ProjectConfig -> LibM ProjectConfig
forall a b. (a -> b) -> a -> b
$ [Char] -> LibErrorIO ProjectConfig
findProjectConfig' [Char]
root
findProjectConfig'
:: FilePath
-> LibErrorIO ProjectConfig
findProjectConfig' :: [Char] -> LibErrorIO ProjectConfig
findProjectConfig' [Char]
root = do
[Char]
-> WriterT LibErrWarns (StateT LibState IO) (Maybe ProjectConfig)
forall (m :: * -> *).
(MonadState LibState m, MonadIO m) =>
[Char] -> m (Maybe ProjectConfig)
getCachedProjectConfig [Char]
root WriterT LibErrWarns (StateT LibState IO) (Maybe ProjectConfig)
-> (Maybe ProjectConfig -> LibErrorIO ProjectConfig)
-> LibErrorIO ProjectConfig
forall a b.
WriterT LibErrWarns (StateT LibState IO) a
-> (a -> WriterT LibErrWarns (StateT LibState IO) b)
-> WriterT LibErrWarns (StateT LibState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ProjectConfig
conf -> ProjectConfig -> LibErrorIO ProjectConfig
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectConfig
conf
Maybe ProjectConfig
Nothing -> do
[[Char]]
libFiles <- IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
".agda-lib") ([Char] -> Bool) -> ShowS -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension) ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
getDirectoryContents [Char]
root
case [[Char]]
libFiles of
[] -> IO (Maybe [Char])
-> WriterT LibErrWarns (StateT LibState IO) (Maybe [Char])
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO (Maybe [Char])
upPath [Char]
root) WriterT LibErrWarns (StateT LibState IO) (Maybe [Char])
-> (Maybe [Char] -> LibErrorIO ProjectConfig)
-> LibErrorIO ProjectConfig
forall a b.
WriterT LibErrWarns (StateT LibState IO) a
-> (a -> WriterT LibErrWarns (StateT LibState IO) b)
-> WriterT LibErrWarns (StateT LibState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just [Char]
up -> do
ProjectConfig
conf <- [Char] -> LibErrorIO ProjectConfig
findProjectConfig' [Char]
up
ProjectConfig
conf <- ProjectConfig -> LibErrorIO ProjectConfig
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig -> LibErrorIO ProjectConfig)
-> ProjectConfig -> LibErrorIO ProjectConfig
forall a b. (a -> b) -> a -> b
$ case ProjectConfig
conf of
DefaultProjectConfig{} -> ProjectConfig
conf
ProjectConfig{LineNumber
[Char]
[[Char]]
configRoot :: [Char]
configAgdaLibFiles :: [[Char]]
configAbove :: LineNumber
configAbove :: ProjectConfig -> LineNumber
configAgdaLibFiles :: ProjectConfig -> [[Char]]
configRoot :: ProjectConfig -> [Char]
..} ->
ProjectConfig{ configAbove :: LineNumber
configAbove = LineNumber
configAbove LineNumber -> LineNumber -> LineNumber
forall a. Num a => a -> a -> a
+ LineNumber
1
, [Char]
[[Char]]
configRoot :: [Char]
configAgdaLibFiles :: [[Char]]
configAgdaLibFiles :: [[Char]]
configRoot :: [Char]
..
}
[Char]
-> ProjectConfig -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
(MonadState LibState m, MonadIO m) =>
[Char] -> ProjectConfig -> m ()
storeCachedProjectConfig [Char]
root ProjectConfig
conf
ProjectConfig -> LibErrorIO ProjectConfig
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectConfig
conf
Maybe [Char]
Nothing -> ProjectConfig -> LibErrorIO ProjectConfig
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectConfig
DefaultProjectConfig
[[Char]]
files -> do
let conf :: ProjectConfig
conf = [Char] -> [[Char]] -> LineNumber -> ProjectConfig
ProjectConfig [Char]
root [[Char]]
files LineNumber
0
[Char]
-> ProjectConfig -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
(MonadState LibState m, MonadIO m) =>
[Char] -> ProjectConfig -> m ()
storeCachedProjectConfig [Char]
root ProjectConfig
conf
ProjectConfig -> LibErrorIO ProjectConfig
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectConfig
conf
where
upPath :: FilePath -> IO (Maybe FilePath)
upPath :: [Char] -> IO (Maybe [Char])
upPath [Char]
root = do
[Char]
up <- [Char] -> IO [Char]
canonicalizePath ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
root [Char] -> ShowS
</> [Char]
".."
if [Char]
up [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
root then Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing else Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
up
findProjectRoot :: FilePath -> LibM (Maybe FilePath)
findProjectRoot :: [Char] -> LibM (Maybe [Char])
findProjectRoot [Char]
root = [Char] -> LibM ProjectConfig
findProjectConfig [Char]
root LibM ProjectConfig
-> (ProjectConfig -> Maybe [Char]) -> LibM (Maybe [Char])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
ProjectConfig [Char]
p [[Char]]
_ LineNumber
_ -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
p
ProjectConfig
DefaultProjectConfig -> Maybe [Char]
forall a. Maybe a
Nothing
getAgdaLibFiles' :: FilePath -> LibErrorIO [AgdaLibFile]
getAgdaLibFiles' :: [Char] -> LibErrorIO [AgdaLibFile]
getAgdaLibFiles' [Char]
path = [Char] -> LibErrorIO ProjectConfig
findProjectConfig' [Char]
path LibErrorIO ProjectConfig
-> (ProjectConfig -> LibErrorIO [AgdaLibFile])
-> LibErrorIO [AgdaLibFile]
forall a b.
WriterT LibErrWarns (StateT LibState IO) a
-> (a -> WriterT LibErrWarns (StateT LibState IO) b)
-> WriterT LibErrWarns (StateT LibState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ProjectConfig
DefaultProjectConfig -> [AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
ProjectConfig [Char]
root [[Char]]
libs LineNumber
above ->
(AgdaLibFile -> AgdaLibFile) -> [AgdaLibFile] -> [AgdaLibFile]
forall a b. (a -> b) -> [a] -> [b]
map (Lens' AgdaLibFile LineNumber -> LensSet AgdaLibFile LineNumber
forall o i. Lens' o i -> LensSet o i
set (LineNumber -> f LineNumber) -> AgdaLibFile -> f AgdaLibFile
Lens' AgdaLibFile LineNumber
libAbove LineNumber
above) ([AgdaLibFile] -> [AgdaLibFile])
-> LibErrorIO [AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Maybe LibrariesFile
-> [(LineNumber, [Char])] -> LibErrorIO [AgdaLibFile]
parseLibFiles Maybe LibrariesFile
forall a. Maybe a
Nothing (([Char] -> (LineNumber, [Char]))
-> [[Char]] -> [(LineNumber, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((LineNumber
0,) ([Char] -> (LineNumber, [Char]))
-> ShowS -> [Char] -> (LineNumber, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
root [Char] -> ShowS
</>)) [[Char]]
libs)
getDefaultLibraries
:: FilePath
-> Bool
-> LibM ([LibName], [FilePath])
getDefaultLibraries :: [Char] -> Bool -> LibM ([[Char]], [[Char]])
getDefaultLibraries [Char]
root Bool
optDefaultLibs = [AgdaLibFile]
-> LibErrorIO ([[Char]], [[Char]]) -> LibM ([[Char]], [[Char]])
forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [] (LibErrorIO ([[Char]], [[Char]]) -> LibM ([[Char]], [[Char]]))
-> LibErrorIO ([[Char]], [[Char]]) -> LibM ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ do
[AgdaLibFile]
libs <- [Char] -> LibErrorIO [AgdaLibFile]
getAgdaLibFiles' [Char]
root
if [AgdaLibFile] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AgdaLibFile]
libs
then (,[]) ([[Char]] -> ([[Char]], [[Char]]))
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> LibErrorIO ([[Char]], [[Char]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
optDefaultLibs then ([Char]
libNameForCurrentDir [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:) ([[Char]] -> [[Char]])
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT LibErrWarns (StateT LibState IO) [[Char]]
readDefaultsFile else [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else ([[Char]], [[Char]]) -> LibErrorIO ([[Char]], [[Char]])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (([[Char]], [[Char]]) -> LibErrorIO ([[Char]], [[Char]]))
-> ([[Char]], [[Char]]) -> LibErrorIO ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ [AgdaLibFile] -> ([[Char]], [[Char]])
forall {t :: * -> *}.
Foldable t =>
t AgdaLibFile -> ([[Char]], [[Char]])
libsAndPaths [AgdaLibFile]
libs
where
libsAndPaths :: t AgdaLibFile -> ([[Char]], [[Char]])
libsAndPaths t AgdaLibFile
ls = ( (AgdaLibFile -> [[Char]]) -> t AgdaLibFile -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AgdaLibFile -> [[Char]]
_libDepends t AgdaLibFile
ls
, ShowS -> [[Char]] -> [[Char]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn ShowS
forall a. a -> a
id ((AgdaLibFile -> [[Char]]) -> t AgdaLibFile -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AgdaLibFile -> [[Char]]
_libIncludes t AgdaLibFile
ls)
)
readDefaultsFile :: LibErrorIO [LibName]
readDefaultsFile :: WriterT LibErrWarns (StateT LibState IO) [[Char]]
readDefaultsFile = do
[Char]
agdaDir <- IO [Char] -> WriterT LibErrWarns (StateT LibState IO) [Char]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Char]
getAgdaAppDir
let file :: [Char]
file = [Char]
agdaDir [Char] -> ShowS
</> [Char]
defaultsFile
WriterT LibErrWarns (StateT LibState IO) Bool
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (IO Bool -> WriterT LibErrWarns (StateT LibState IO) Bool
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> WriterT LibErrWarns (StateT LibState IO) Bool)
-> IO Bool -> WriterT LibErrWarns (StateT LibState IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
file) ([[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a b. (a -> b) -> a -> b
$ do
[[Char]]
ls <- IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> IO [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a b. (a -> b) -> a -> b
$ ((LineNumber, [Char]) -> [Char])
-> [(LineNumber, [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (LineNumber, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ([(LineNumber, [Char])] -> [[Char]])
-> ([Char] -> [(LineNumber, [Char])]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [(LineNumber, [Char])]
stripCommentLines ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
UTF8.readFile [Char]
file
[[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> [[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Char] -> [[Char]]
splitCommas [[Char]]
ls
WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> (IOException
-> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a.
WriterT LibErrWarns (StateT LibState IO) a
-> (IOException -> WriterT LibErrWarns (StateT LibState IO) a)
-> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a.
CatchIO m =>
m a -> (IOException -> m a) -> m a
`catchIO` \ IOException
e -> do
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [ IOException -> [Char] -> LibError'
ReadError IOException
e [Char]
"Failed to read defaults file." ]
[[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getLibrariesFile
:: (MonadIO m, MonadError FilePath m)
=> Maybe FilePath
-> m LibrariesFile
getLibrariesFile :: forall (m :: * -> *).
(MonadIO m, MonadError [Char] m) =>
Maybe [Char] -> m LibrariesFile
getLibrariesFile (Just [Char]
overrideLibFile) = do
m Bool -> m LibrariesFile -> m LibrariesFile -> m LibrariesFile
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
overrideLibFile)
(LibrariesFile -> m LibrariesFile
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LibrariesFile -> m LibrariesFile)
-> LibrariesFile -> m LibrariesFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> LibrariesFile
LibrariesFile [Char]
overrideLibFile Bool
True)
([Char] -> m LibrariesFile
forall a. [Char] -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
overrideLibFile)
getLibrariesFile Maybe [Char]
Nothing = do
[Char]
agdaDir <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char]
getAgdaAppDir
let defaults :: NonEmpty [Char]
defaults = ShowS -> NonEmpty [Char] -> NonEmpty [Char]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
List1.map ([Char]
agdaDir [Char] -> ShowS
</>) NonEmpty [Char]
defaultLibraryFiles
[[Char]]
files <- IO [[Char]] -> m [[Char]]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> m [[Char]]) -> IO [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist (NonEmpty [Char] -> [Item (NonEmpty [Char])]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty [Char]
defaults)
case [[Char]]
files of
[Char]
file : [[Char]]
_ -> LibrariesFile -> m LibrariesFile
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LibrariesFile -> m LibrariesFile)
-> LibrariesFile -> m LibrariesFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> LibrariesFile
LibrariesFile [Char]
file Bool
True
[] -> LibrariesFile -> m LibrariesFile
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LibrariesFile -> m LibrariesFile)
-> LibrariesFile -> m LibrariesFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> LibrariesFile
LibrariesFile (NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
List1.last NonEmpty [Char]
defaults) Bool
False
getInstalledLibraries
:: Maybe FilePath
-> LibM [AgdaLibFile]
getInstalledLibraries :: Maybe [Char] -> LibM [AgdaLibFile]
getInstalledLibraries Maybe [Char]
overrideLibFile = [AgdaLibFile] -> LibErrorIO [AgdaLibFile] -> LibM [AgdaLibFile]
forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [] (LibErrorIO [AgdaLibFile] -> LibM [AgdaLibFile])
-> LibErrorIO [AgdaLibFile] -> LibM [AgdaLibFile]
forall a b. (a -> b) -> a -> b
$ do
Either [Char] LibrariesFile
filem <- IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile)
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile))
-> IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile)
forall a b. (a -> b) -> a -> b
$ ExceptT [Char] IO LibrariesFile -> IO (Either [Char] LibrariesFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO LibrariesFile
-> IO (Either [Char] LibrariesFile))
-> ExceptT [Char] IO LibrariesFile
-> IO (Either [Char] LibrariesFile)
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> ExceptT [Char] IO LibrariesFile
forall (m :: * -> *).
(MonadIO m, MonadError [Char] m) =>
Maybe [Char] -> m LibrariesFile
getLibrariesFile Maybe [Char]
overrideLibFile
case Either [Char] LibrariesFile
filem of
Left [Char]
theOverrideLibFile -> do
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [ [Char] -> LibError'
LibrariesFileNotFound [Char]
theOverrideLibFile ]
[AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right LibrariesFile
file -> do
if Bool -> Bool
not (LibrariesFile -> Bool
lfExists LibrariesFile
file) then [AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
[(LineNumber, [Char])]
ls <- IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])])
-> IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a b. (a -> b) -> a -> b
$ [Char] -> [(LineNumber, [Char])]
stripCommentLines ([Char] -> [(LineNumber, [Char])])
-> IO [Char] -> IO [(LineNumber, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
UTF8.readFile (LibrariesFile -> [Char]
lfPath LibrariesFile
file)
[(LineNumber, [Char])]
files <- IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])])
-> IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a b. (a -> b) -> a -> b
$ [IO (LineNumber, [Char])] -> IO [(LineNumber, [Char])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ (LineNumber
i, ) ([Char] -> (LineNumber, [Char]))
-> IO [Char] -> IO (LineNumber, [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
expandEnvironmentVariables [Char]
s | (LineNumber
i, [Char]
s) <- [(LineNumber, [Char])]
ls ]
Maybe LibrariesFile
-> [(LineNumber, [Char])] -> LibErrorIO [AgdaLibFile]
parseLibFiles (LibrariesFile -> Maybe LibrariesFile
forall a. a -> Maybe a
Just LibrariesFile
file) ([(LineNumber, [Char])] -> LibErrorIO [AgdaLibFile])
-> [(LineNumber, [Char])] -> LibErrorIO [AgdaLibFile]
forall a b. (a -> b) -> a -> b
$ ((LineNumber, [Char]) -> [Char])
-> [(LineNumber, [Char])] -> [(LineNumber, [Char])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn (LineNumber, [Char]) -> [Char]
forall a b. (a, b) -> b
snd [(LineNumber, [Char])]
files
LibErrorIO [AgdaLibFile]
-> (IOException -> LibErrorIO [AgdaLibFile])
-> LibErrorIO [AgdaLibFile]
forall a.
WriterT LibErrWarns (StateT LibState IO) a
-> (IOException -> WriterT LibErrWarns (StateT LibState IO) a)
-> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a.
CatchIO m =>
m a -> (IOException -> m a) -> m a
`catchIO` \ IOException
e -> do
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [ IOException -> [Char] -> LibError'
ReadError IOException
e [Char]
"Failed to read installed libraries." ]
[AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
parseLibFiles
:: Maybe LibrariesFile
-> [(LineNumber, FilePath)]
-> LibErrorIO [AgdaLibFile]
parseLibFiles :: Maybe LibrariesFile
-> [(LineNumber, [Char])] -> LibErrorIO [AgdaLibFile]
parseLibFiles Maybe LibrariesFile
mlibFile [(LineNumber, [Char])]
files = do
[(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])]
anns <- [(LineNumber, [Char])]
-> ((LineNumber, [Char])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning]))
-> WriterT
LibErrWarns
(StateT LibState IO)
[(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(LineNumber, [Char])]
files (((LineNumber, [Char])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning]))
-> WriterT
LibErrWarns
(StateT LibState IO)
[(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])])
-> ((LineNumber, [Char])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning]))
-> WriterT
LibErrWarns
(StateT LibState IO)
[(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])]
forall a b. (a -> b) -> a -> b
$ \(LineNumber
ln, [Char]
file) -> do
[Char]
-> WriterT LibErrWarns (StateT LibState IO) (Maybe AgdaLibFile)
forall (m :: * -> *).
(MonadState LibState m, MonadIO m) =>
[Char] -> m (Maybe AgdaLibFile)
getCachedAgdaLibFile [Char]
file WriterT LibErrWarns (StateT LibState IO) (Maybe AgdaLibFile)
-> (Maybe AgdaLibFile
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning]))
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
forall a b.
WriterT LibErrWarns (StateT LibState IO) a
-> (a -> WriterT LibErrWarns (StateT LibState IO) b)
-> WriterT LibErrWarns (StateT LibState IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just AgdaLibFile
lib -> (Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AgdaLibFile
-> Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile
forall a b. b -> Either a b
Right AgdaLibFile
lib, [])
Maybe AgdaLibFile
Nothing -> do
(Either LibParseError AgdaLibFile
e, [LibWarning']
ws) <- IO (Either LibParseError AgdaLibFile, [LibWarning'])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either LibParseError AgdaLibFile, [LibWarning'])
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either LibParseError AgdaLibFile, [LibWarning'])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either LibParseError AgdaLibFile, [LibWarning']))
-> IO (Either LibParseError AgdaLibFile, [LibWarning'])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either LibParseError AgdaLibFile, [LibWarning'])
forall a b. (a -> b) -> a -> b
$ P AgdaLibFile -> (Either LibParseError AgdaLibFile, [LibWarning'])
forall a. P a -> (Either LibParseError a, [LibWarning'])
runP (P AgdaLibFile
-> (Either LibParseError AgdaLibFile, [LibWarning']))
-> IO (P AgdaLibFile)
-> IO (Either LibParseError AgdaLibFile, [LibWarning'])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (P AgdaLibFile)
parseLibFile [Char]
file
let pos :: LibPositionInfo
pos = Maybe [Char] -> LineNumber -> [Char] -> LibPositionInfo
LibPositionInfo (LibrariesFile -> [Char]
lfPath (LibrariesFile -> [Char]) -> Maybe LibrariesFile -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LibrariesFile
mlibFile) LineNumber
ln [Char]
file
ws' :: [LibWarning]
ws' = (LibWarning' -> LibWarning) -> [LibWarning'] -> [LibWarning]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe LibPositionInfo -> LibWarning' -> LibWarning
LibWarning (LibPositionInfo -> Maybe LibPositionInfo
forall a. a -> Maybe a
Just LibPositionInfo
pos)) [LibWarning']
ws
case Either LibParseError AgdaLibFile
e of
Left LibParseError
err -> do
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe LibPositionInfo, LibParseError)
-> Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile
forall a b. a -> Either a b
Left (LibPositionInfo -> Maybe LibPositionInfo
forall a. a -> Maybe a
Just LibPositionInfo
pos, LibParseError
err), [LibWarning]
ws')
Right AgdaLibFile
lib -> do
[Char]
-> AgdaLibFile -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
(MonadState LibState m, MonadIO m) =>
[Char] -> AgdaLibFile -> m ()
storeCachedAgdaLibFile [Char]
file AgdaLibFile
lib
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
-> WriterT
LibErrWarns
(StateT LibState IO)
(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AgdaLibFile
-> Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile
forall a b. b -> Either a b
Right AgdaLibFile
lib, [LibWarning]
ws')
let ([Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile]
xs, [[LibWarning]]
warns) = [(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])]
-> ([Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile],
[[LibWarning]])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile,
[LibWarning])]
anns
([(Maybe LibPositionInfo, LibParseError)]
errs, [AgdaLibFile]
als) = [Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile]
-> ([(Maybe LibPositionInfo, LibParseError)], [AgdaLibFile])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Maybe LibPositionInfo, LibParseError) AgdaLibFile]
xs
[LibWarning]
-> (List1 LibWarning
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ()
forall m a. Null m => [a] -> (List1 a -> m) -> m
List1.unlessNull ([[LibWarning]] -> [LibWarning]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LibWarning]]
warns) List1 LibWarning -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibWarning -> m ()
warnings
[(Maybe LibPositionInfo, LibParseError)]
-> (List1 (Maybe LibPositionInfo, LibParseError)
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ()
forall m a. Null m => [a] -> (List1 a -> m) -> m
List1.unlessNull [(Maybe LibPositionInfo, LibParseError)]
errs ((List1 (Maybe LibPositionInfo, LibParseError)
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ())
-> (List1 (Maybe LibPositionInfo, LibParseError)
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ()
forall a b. (a -> b) -> a -> b
$ \ List1 (Maybe LibPositionInfo, LibParseError)
errs1 ->
List1 LibError -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError -> m ()
raiseErrors (List1 LibError -> WriterT LibErrWarns (StateT LibState IO) ())
-> List1 LibError -> WriterT LibErrWarns (StateT LibState IO) ()
forall a b. (a -> b) -> a -> b
$ ((Maybe LibPositionInfo, LibParseError) -> LibError)
-> List1 (Maybe LibPositionInfo, LibParseError) -> List1 LibError
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (Maybe LibPositionInfo
mc, LibParseError
err) -> Maybe LibPositionInfo -> LibError' -> LibError
LibError Maybe LibPositionInfo
mc (LibError' -> LibError) -> LibError' -> LibError
forall a b. (a -> b) -> a -> b
$ LibParseError -> LibError'
LibParseError LibParseError
err) List1 (Maybe LibPositionInfo, LibParseError)
errs1
[AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AgdaLibFile] -> LibErrorIO [AgdaLibFile])
-> [AgdaLibFile] -> LibErrorIO [AgdaLibFile]
forall a b. (a -> b) -> a -> b
$ (AgdaLibFile -> [Char]) -> [AgdaLibFile] -> [AgdaLibFile]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn AgdaLibFile -> [Char]
_libFile [AgdaLibFile]
als
stripCommentLines :: String -> [(LineNumber, String)]
= ((LineNumber, [Char]) -> [(LineNumber, [Char])])
-> [(LineNumber, [Char])] -> [(LineNumber, [Char])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (LineNumber, [Char]) -> [(LineNumber, [Char])]
forall {a}. (a, [Char]) -> [(a, [Char])]
strip ([(LineNumber, [Char])] -> [(LineNumber, [Char])])
-> ([Char] -> [(LineNumber, [Char])])
-> [Char]
-> [(LineNumber, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LineNumber] -> [[Char]] -> [(LineNumber, [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [LineNumber
Item [LineNumber]
1..] ([[Char]] -> [(LineNumber, [Char])])
-> ([Char] -> [[Char]]) -> [Char] -> [(LineNumber, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
where
strip :: (a, [Char]) -> [(a, [Char])]
strip (a
i, [Char]
s) = [ (a
i, [Char]
s') | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s' ]
where s' :: [Char]
s' = ShowS
trimLineComment [Char]
s
getExecutablesFile
:: IO ExecutablesFile
getExecutablesFile :: IO ExecutablesFile
getExecutablesFile = do
[Char]
agdaDir <- IO [Char]
getAgdaAppDir
let defaults :: NonEmpty [Char]
defaults = ShowS -> NonEmpty [Char] -> NonEmpty [Char]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
List1.map ([Char]
agdaDir [Char] -> ShowS
</>) NonEmpty [Char]
defaultExecutableFiles
[[Char]]
files <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist (NonEmpty [Char] -> [Item (NonEmpty [Char])]
forall l. IsList l => l -> [Item l]
List1.toList NonEmpty [Char]
defaults)
case [[Char]]
files of
[Char]
file : [[Char]]
_ -> ExecutablesFile -> IO ExecutablesFile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExecutablesFile -> IO ExecutablesFile)
-> ExecutablesFile -> IO ExecutablesFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> ExecutablesFile
ExecutablesFile [Char]
file Bool
True
[] -> ExecutablesFile -> IO ExecutablesFile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExecutablesFile -> IO ExecutablesFile)
-> ExecutablesFile -> IO ExecutablesFile
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> ExecutablesFile
ExecutablesFile (NonEmpty [Char] -> [Char]
forall a. NonEmpty a -> a
List1.last NonEmpty [Char]
defaults) Bool
False
getTrustedExecutables
:: LibM (Map ExeName FilePath)
getTrustedExecutables :: LibM (Map ExeName [Char])
getTrustedExecutables = [AgdaLibFile]
-> LibErrorIO (Map ExeName [Char]) -> LibM (Map ExeName [Char])
forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [] (LibErrorIO (Map ExeName [Char]) -> LibM (Map ExeName [Char]))
-> LibErrorIO (Map ExeName [Char]) -> LibM (Map ExeName [Char])
forall a b. (a -> b) -> a -> b
$ do
ExecutablesFile
file <- IO ExecutablesFile
-> WriterT LibErrWarns (StateT LibState IO) ExecutablesFile
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ExecutablesFile
getExecutablesFile
if Bool -> Bool
not (ExecutablesFile -> Bool
efExists ExecutablesFile
file) then Map ExeName [Char] -> LibErrorIO (Map ExeName [Char])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map ExeName [Char]
forall k a. Map k a
Map.empty else do
[(LineNumber, [Char])]
es <- IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])])
-> IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a b. (a -> b) -> a -> b
$ [Char] -> [(LineNumber, [Char])]
stripCommentLines ([Char] -> [(LineNumber, [Char])])
-> IO [Char] -> IO [(LineNumber, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
UTF8.readFile (ExecutablesFile -> [Char]
efPath ExecutablesFile
file)
[(LineNumber, [Char])]
lines <- IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])])
-> IO [(LineNumber, [Char])]
-> WriterT LibErrWarns (StateT LibState IO) [(LineNumber, [Char])]
forall a b. (a -> b) -> a -> b
$ ((LineNumber, [Char]) -> IO (LineNumber, [Char]))
-> [(LineNumber, [Char])] -> IO [(LineNumber, [Char])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Char] -> IO [Char])
-> (LineNumber, [Char]) -> IO (LineNumber, [Char])
forall (m :: * -> *) b d a.
Functor m =>
(b -> m d) -> (a, b) -> m (a, d)
mapSndM [Char] -> IO [Char]
expandEnvironmentVariables) [(LineNumber, [Char])]
es
ExecutablesFile
-> [(LineNumber, [Char])] -> LibErrorIO (Map ExeName [Char])
parseExecutablesFile ExecutablesFile
file [(LineNumber, [Char])]
lines
LibErrorIO (Map ExeName [Char])
-> (IOException -> LibErrorIO (Map ExeName [Char]))
-> LibErrorIO (Map ExeName [Char])
forall a.
WriterT LibErrWarns (StateT LibState IO) a
-> (IOException -> WriterT LibErrWarns (StateT LibState IO) a)
-> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a.
CatchIO m =>
m a -> (IOException -> m a) -> m a
`catchIO` \ IOException
e -> do
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [ IOException -> [Char] -> LibError'
ReadError IOException
e [Char]
"Failed to read trusted executables." ]
Map ExeName [Char] -> LibErrorIO (Map ExeName [Char])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map ExeName [Char]
forall k a. Map k a
Map.empty
parseExecutablesFile
:: ExecutablesFile
-> [(LineNumber, FilePath)]
-> LibErrorIO (Map ExeName FilePath)
parseExecutablesFile :: ExecutablesFile
-> [(LineNumber, [Char])] -> LibErrorIO (Map ExeName [Char])
parseExecutablesFile ExecutablesFile
ef [(LineNumber, [Char])]
files = do
[(ExeName, (LineNumber, [Char]))]
executables <- [(LineNumber, [Char])]
-> ((LineNumber, [Char])
-> WriterT
LibErrWarns (StateT LibState IO) (ExeName, (LineNumber, [Char])))
-> WriterT
LibErrWarns (StateT LibState IO) [(ExeName, (LineNumber, [Char]))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(LineNumber, [Char])]
files (((LineNumber, [Char])
-> WriterT
LibErrWarns (StateT LibState IO) (ExeName, (LineNumber, [Char])))
-> WriterT
LibErrWarns (StateT LibState IO) [(ExeName, (LineNumber, [Char]))])
-> ((LineNumber, [Char])
-> WriterT
LibErrWarns (StateT LibState IO) (ExeName, (LineNumber, [Char])))
-> WriterT
LibErrWarns (StateT LibState IO) [(ExeName, (LineNumber, [Char]))]
forall a b. (a -> b) -> a -> b
$ \(LineNumber
ln, [Char]
fp) -> do
let strExeName :: [Char]
strExeName = ShowS
takeFileName [Char]
fp
let strExeName' :: [Char]
strExeName' = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
strExeName (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
stripExtension [Char]
exeExtension [Char]
strExeName
let txtExeName :: ExeName
txtExeName = [Char] -> ExeName
T.pack [Char]
strExeName'
[Char]
exePath <- IO [Char] -> WriterT LibErrWarns (StateT LibState IO) [Char]
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> WriterT LibErrWarns (StateT LibState IO) [Char])
-> IO [Char] -> WriterT LibErrWarns (StateT LibState IO) [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
makeAbsolute [Char]
fp
(ExeName, (LineNumber, [Char]))
-> WriterT
LibErrWarns (StateT LibState IO) (ExeName, (LineNumber, [Char]))
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExeName
txtExeName, (LineNumber
ln, [Char]
exePath))
let exeMap1 :: Map ExeName (List1 (LineNumber, FilePath))
exeMap1 :: Map ExeName (List1 (LineNumber, [Char]))
exeMap1 = (List1 (LineNumber, [Char])
-> List1 (LineNumber, [Char]) -> List1 (LineNumber, [Char]))
-> [(ExeName, List1 (LineNumber, [Char]))]
-> Map ExeName (List1 (LineNumber, [Char]))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith List1 (LineNumber, [Char])
-> List1 (LineNumber, [Char]) -> List1 (LineNumber, [Char])
forall a. Semigroup a => a -> a -> a
(<>) ([(ExeName, List1 (LineNumber, [Char]))]
-> Map ExeName (List1 (LineNumber, [Char])))
-> [(ExeName, List1 (LineNumber, [Char]))]
-> Map ExeName (List1 (LineNumber, [Char]))
forall a b. (a -> b) -> a -> b
$ ((ExeName, (LineNumber, [Char]))
-> (ExeName, List1 (LineNumber, [Char])))
-> [(ExeName, (LineNumber, [Char]))]
-> [(ExeName, List1 (LineNumber, [Char]))]
forall a b. (a -> b) -> [a] -> [b]
map (((LineNumber, [Char]) -> List1 (LineNumber, [Char]))
-> (ExeName, (LineNumber, [Char]))
-> (ExeName, List1 (LineNumber, [Char]))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (LineNumber, [Char]) -> List1 (LineNumber, [Char])
forall el coll. Singleton el coll => el -> coll
singleton) ([(ExeName, (LineNumber, [Char]))]
-> [(ExeName, List1 (LineNumber, [Char]))])
-> [(ExeName, (LineNumber, [Char]))]
-> [(ExeName, List1 (LineNumber, [Char]))]
forall a b. (a -> b) -> a -> b
$ [(ExeName, (LineNumber, [Char]))]
-> [(ExeName, (LineNumber, [Char]))]
forall a. [a] -> [a]
reverse [(ExeName, (LineNumber, [Char]))]
executables
let (Map ExeName (LineNumber, [Char])
exeMap, Map ExeName (List2 (LineNumber, [Char]))
duplicates) = (List1 (LineNumber, [Char])
-> Either (LineNumber, [Char]) (List2 (LineNumber, [Char])))
-> Map ExeName (List1 (LineNumber, [Char]))
-> (Map ExeName (LineNumber, [Char]),
Map ExeName (List2 (LineNumber, [Char])))
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither List1 (LineNumber, [Char])
-> Either (LineNumber, [Char]) (List2 (LineNumber, [Char]))
forall a. List1 a -> Either a (List2 a)
List2.fromList1Either Map ExeName (List1 (LineNumber, [Char]))
exeMap1
[(ExeName, List2 (LineNumber, [Char]))]
-> (List1 (ExeName, List2 (LineNumber, [Char]))
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ()
forall m a. Null m => [a] -> (List1 a -> m) -> m
List1.unlessNull (Map ExeName (List2 (LineNumber, [Char]))
-> [(ExeName, List2 (LineNumber, [Char]))]
forall k a. Map k a -> [(k, a)]
Map.toList Map ExeName (List2 (LineNumber, [Char]))
duplicates) ((List1 (ExeName, List2 (LineNumber, [Char]))
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ())
-> (List1 (ExeName, List2 (LineNumber, [Char]))
-> WriterT LibErrWarns (StateT LibState IO) ())
-> WriterT LibErrWarns (StateT LibState IO) ()
forall a b. (a -> b) -> a -> b
$ \ List1 (ExeName, List2 (LineNumber, [Char]))
duplicates1 ->
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' (List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ())
-> List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall a b. (a -> b) -> a -> b
$ ((ExeName, List2 (LineNumber, [Char])) -> LibError')
-> List1 (ExeName, List2 (LineNumber, [Char])) -> List1 LibError'
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExeName -> List2 (LineNumber, [Char]) -> LibError')
-> (ExeName, List2 (LineNumber, [Char])) -> LibError'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ExeName -> List2 (LineNumber, [Char]) -> LibError')
-> (ExeName, List2 (LineNumber, [Char])) -> LibError')
-> (ExeName -> List2 (LineNumber, [Char]) -> LibError')
-> (ExeName, List2 (LineNumber, [Char]))
-> LibError'
forall a b. (a -> b) -> a -> b
$ [Char] -> ExeName -> List2 (LineNumber, [Char]) -> LibError'
DuplicateExecutable ([Char] -> ExeName -> List2 (LineNumber, [Char]) -> LibError')
-> [Char] -> ExeName -> List2 (LineNumber, [Char]) -> LibError'
forall a b. (a -> b) -> a -> b
$ ExecutablesFile -> [Char]
efPath ExecutablesFile
ef) List1 (ExeName, List2 (LineNumber, [Char]))
duplicates1
Map ExeName [Char] -> LibErrorIO (Map ExeName [Char])
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ExeName [Char] -> LibErrorIO (Map ExeName [Char]))
-> Map ExeName [Char] -> LibErrorIO (Map ExeName [Char])
forall a b. (a -> b) -> a -> b
$ ((LineNumber, [Char]) -> [Char])
-> Map ExeName (LineNumber, [Char]) -> Map ExeName [Char]
forall a b. (a -> b) -> Map ExeName a -> Map ExeName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LineNumber, [Char]) -> [Char]
forall a b. (a, b) -> b
snd Map ExeName (LineNumber, [Char])
exeMap
libraryIncludePaths
:: Maybe FilePath
-> [AgdaLibFile]
-> [LibName]
-> LibM [FilePath]
libraryIncludePaths :: Maybe [Char] -> [AgdaLibFile] -> [[Char]] -> LibM [[Char]]
libraryIncludePaths Maybe [Char]
overrideLibFile [AgdaLibFile]
libs [[Char]]
xs0 = [AgdaLibFile]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> LibM [[Char]]
forall a. [AgdaLibFile] -> LibErrorIO a -> LibM a
mkLibM [AgdaLibFile]
libs (WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> LibM [[Char]])
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
-> LibM [[Char]]
forall a b. (a -> b) -> a -> b
$ do
Either [Char] LibrariesFile
efile <- IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile)
forall a. IO a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile))
-> IO (Either [Char] LibrariesFile)
-> WriterT
LibErrWarns (StateT LibState IO) (Either [Char] LibrariesFile)
forall a b. (a -> b) -> a -> b
$ ExceptT [Char] IO LibrariesFile -> IO (Either [Char] LibrariesFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO LibrariesFile
-> IO (Either [Char] LibrariesFile))
-> ExceptT [Char] IO LibrariesFile
-> IO (Either [Char] LibrariesFile)
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> ExceptT [Char] IO LibrariesFile
forall (m :: * -> *).
(MonadIO m, MonadError [Char] m) =>
Maybe [Char] -> m LibrariesFile
getLibrariesFile Maybe [Char]
overrideLibFile
case Either [Char] LibrariesFile
efile of
Left [Char]
theOverrideLibFile -> do
List1 LibError' -> WriterT LibErrWarns (StateT LibState IO) ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [ [Char] -> LibError'
LibrariesFileNotFound [Char]
theOverrideLibFile ]
[[Char]] -> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a. a -> WriterT LibErrWarns (StateT LibState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Right LibrariesFile
file -> Writer LibErrWarns [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
Writer w a -> WriterT w m a
embedWriter (Writer LibErrWarns [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]])
-> Writer LibErrWarns [[Char]]
-> WriterT LibErrWarns (StateT LibState IO) [[Char]]
forall a b. (a -> b) -> a -> b
$ ([[Char]]
dot [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> ([AgdaLibFile] -> [[Char]]) -> [AgdaLibFile] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AgdaLibFile] -> [[Char]]
incs ([AgdaLibFile] -> [[Char]])
-> WriterT LibErrWarns Identity [AgdaLibFile]
-> Writer LibErrWarns [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LibrariesFile
-> [[Char]]
-> [[Char]]
-> WriterT LibErrWarns Identity [AgdaLibFile]
find LibrariesFile
file [] [[Char]]
xs
where
([[Char]]
dots, [[Char]]
xs) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
libNameForCurrentDir) ([[Char]] -> ([[Char]], [[Char]]))
-> [[Char]] -> ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
xs0
incs :: [AgdaLibFile] -> [[Char]]
incs = ShowS -> [[Char]] -> [[Char]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn ShowS
forall a. a -> a
id ([[Char]] -> [[Char]])
-> ([AgdaLibFile] -> [[Char]]) -> [AgdaLibFile] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgdaLibFile -> [[Char]]) -> [AgdaLibFile] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AgdaLibFile -> [[Char]]
_libIncludes
dot :: [[Char]]
dot = [ [Char]
"." | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
dots ]
find
:: LibrariesFile
-> [LibName]
-> [LibName]
-> Writer LibErrWarns [AgdaLibFile]
find :: LibrariesFile
-> [[Char]]
-> [[Char]]
-> WriterT LibErrWarns Identity [AgdaLibFile]
find LibrariesFile
_ [[Char]]
_ [] = [AgdaLibFile] -> WriterT LibErrWarns Identity [AgdaLibFile]
forall a. a -> WriterT LibErrWarns Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
find LibrariesFile
file [[Char]]
visited ([Char]
x : [[Char]]
xs)
| [Char]
x [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
visited = LibrariesFile
-> [[Char]]
-> [[Char]]
-> WriterT LibErrWarns Identity [AgdaLibFile]
find LibrariesFile
file [[Char]]
visited [[Char]]
xs
| Bool
otherwise = do
Maybe AgdaLibFile
ml <- case [Char] -> [AgdaLibFile] -> [AgdaLibFile]
findLib [Char]
x [AgdaLibFile]
libs of
[Item [AgdaLibFile]
l] -> Maybe AgdaLibFile
-> WriterT LibErrWarns Identity (Maybe AgdaLibFile)
forall a. a -> WriterT LibErrWarns Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AgdaLibFile -> Maybe AgdaLibFile
forall a. a -> Maybe a
Just Item [AgdaLibFile]
AgdaLibFile
l)
[] -> Maybe AgdaLibFile
forall a. Maybe a
Nothing Maybe AgdaLibFile
-> WriterT LibErrWarns Identity ()
-> WriterT LibErrWarns Identity (Maybe AgdaLibFile)
forall a b.
a
-> WriterT LibErrWarns Identity b -> WriterT LibErrWarns Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ List1 LibError' -> WriterT LibErrWarns Identity ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [LibrariesFile -> [Char] -> LibError'
LibNotFound LibrariesFile
file [Char]
x]
[AgdaLibFile]
ls -> Maybe AgdaLibFile
forall a. Maybe a
Nothing Maybe AgdaLibFile
-> WriterT LibErrWarns Identity ()
-> WriterT LibErrWarns Identity (Maybe AgdaLibFile)
forall a b.
a
-> WriterT LibErrWarns Identity b -> WriterT LibErrWarns Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ List1 LibError' -> WriterT LibErrWarns Identity ()
forall (m :: * -> *).
MonadWriter LibErrWarns m =>
List1 LibError' -> m ()
raiseErrors' [[Char] -> [AgdaLibFile] -> LibError'
AmbiguousLib [Char]
x [AgdaLibFile]
ls]
let xs' :: [[Char]]
xs' = (AgdaLibFile -> [[Char]]) -> Maybe AgdaLibFile -> [[Char]]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AgdaLibFile -> [[Char]]
_libDepends Maybe AgdaLibFile
ml [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
xs
Maybe AgdaLibFile -> [AgdaLibFile] -> [AgdaLibFile]
forall a. Maybe a -> [a] -> [a]
mcons Maybe AgdaLibFile
ml ([AgdaLibFile] -> [AgdaLibFile])
-> WriterT LibErrWarns Identity [AgdaLibFile]
-> WriterT LibErrWarns Identity [AgdaLibFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LibrariesFile
-> [[Char]]
-> [[Char]]
-> WriterT LibErrWarns Identity [AgdaLibFile]
find LibrariesFile
file ([Char]
x [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
visited) [[Char]]
xs'
findLib :: LibName -> [AgdaLibFile] -> [AgdaLibFile]
findLib :: [Char] -> [AgdaLibFile] -> [AgdaLibFile]
findLib = (AgdaLibFile -> [Char]) -> [Char] -> [AgdaLibFile] -> [AgdaLibFile]
forall a. (a -> [Char]) -> [Char] -> [a] -> [a]
findLib' AgdaLibFile -> [Char]
_libName
findLib' :: (a -> LibName) -> LibName -> [a] -> [a]
findLib' :: forall a. (a -> [Char]) -> [Char] -> [a] -> [a]
findLib' a -> [Char]
libName [Char]
x [a]
libs =
case [a]
ls of
a
l : [a]
ls' -> a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((([Char], Bool, [Integer]) -> ([Char], Bool, [Integer]) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (([Char], Bool, [Integer]) -> ([Char], Bool, [Integer]) -> Bool)
-> (a -> ([Char], Bool, [Integer])) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> ([Char], Bool, [Integer])
versionMeasure) a
l) [a]
ls'
[] -> []
where
ls :: [a]
ls = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((([Char], Bool, [Integer])
-> ([Char], Bool, [Integer]) -> Ordering)
-> ([Char], Bool, [Integer])
-> ([Char], Bool, [Integer])
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Char], Bool, [Integer]) -> ([Char], Bool, [Integer]) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (([Char], Bool, [Integer])
-> ([Char], Bool, [Integer]) -> Ordering)
-> (a -> ([Char], Bool, [Integer])) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> ([Char], Bool, [Integer])
versionMeasure)
[ a
l | a
l <- [a]
libs, [Char]
x [Char] -> [Char] -> Bool
`hasMatch` a -> [Char]
libName a
l ]
versionMeasure :: a -> ([Char], Bool, [Integer])
versionMeasure a
l = ([Char]
rx, [Integer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Integer]
vs, [Integer]
vs)
where
VersionView [Char]
rx [Integer]
vs = [Char] -> VersionView
versionView (a -> [Char]
libName a
l)
hasMatch :: LibName -> LibName -> Bool
hasMatch :: [Char] -> [Char] -> Bool
hasMatch [Char]
x [Char]
y = [Char]
rx [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
ry Bool -> Bool -> Bool
&& ([Integer]
vx [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer]
vy Bool -> Bool -> Bool
|| [Integer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Integer]
vx)
where
VersionView [Char]
rx [Integer]
vx = [Char] -> VersionView
versionView [Char]
x
VersionView [Char]
ry [Integer]
vy = [Char] -> VersionView
versionView [Char]
y
versionView :: LibName -> VersionView
versionView :: [Char] -> VersionView
versionView [Char]
s =
case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\ Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (ShowS
forall a. [a] -> [a]
reverse [Char]
s) of
([Char]
v, Char
'-' : [Char]
x) | [[Char]] -> Bool
forall {t :: * -> *} {t :: * -> *} {a}.
(IsList (t (t a)), Foldable t, Foldable t) =>
t (t a) -> Bool
valid [[Char]]
vs ->
[Char] -> [Integer] -> VersionView
VersionView (ShowS
forall a. [a] -> [a]
reverse [Char]
x) ([Integer] -> VersionView) -> [Integer] -> VersionView
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
forall a. [a] -> [a]
reverse ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Integer) -> [[Char]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer) -> ShowS -> [Char] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) [[Char]]
vs
where vs :: [[Char]]
vs = (Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [[a]]
chopWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') [Char]
v
valid :: t (t a) -> Bool
valid [] = Bool
False
valid t (t a)
vs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (t a -> Bool) -> t (t a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t (t a)
vs
([Char], [Char])
_ -> [Char] -> [Integer] -> VersionView
VersionView [Char]
s []
unVersionView :: VersionView -> LibName
unVersionView :: VersionView -> [Char]
unVersionView = \case
VersionView [Char]
base [] -> [Char]
base
VersionView [Char]
base [Integer]
vs -> [Char]
base [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"." ((Integer -> [Char]) -> [Integer] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> [Char]
forall a. Show a => a -> [Char]
show [Integer]
vs)