{-# LANGUAGE CPP #-}
module Idris.Package where
import System.Directory
import System.Environment
import System.Exit
import System.FilePath (addExtension, addTrailingPathSeparator, dropExtension,
hasExtension, takeDirectory, takeExtension,
takeFileName, (</>))
import System.IO
import System.Process
import Util.System
import Control.Monad
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.State.Strict (execStateT)
import Data.Either (partitionEithers)
import Data.List
import Data.List.Split (splitOn)
import Idris.AbsSyntax
import Idris.Core.TT
import Idris.Error (ifail)
import Idris.IBC
import Idris.IdrisDoc
import Idris.Imports
import Idris.Main (idris, idrisMain)
import Idris.Options
import Idris.Output
import Idris.Parser (loadModule)
import Idris.Package.Common
import Idris.Package.Parser
import IRTS.System
getPkgDesc :: FilePath -> IO PkgDesc
getPkgDesc :: FilePath -> IO PkgDesc
getPkgDesc = FilePath -> IO PkgDesc
parseDesc
buildPkg :: [Opt]
-> Bool
-> (Bool, FilePath)
-> IO ()
buildPkg :: [Opt] -> Bool -> (Bool, FilePath) -> IO ()
buildPkg [Opt]
copts Bool
warnonly (Bool
install, FilePath
fp) = do
PkgDesc
pkgdesc <- FilePath -> IO PkgDesc
parseDesc FilePath
fp
FilePath
dir <- IO FilePath
getCurrentDirectory
let idx' :: FilePath
idx' = PkgName -> FilePath
pkgIndex (PkgName -> FilePath) -> PkgName -> FilePath
forall a b. (a -> b) -> a -> b
$ PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc
idx :: Opt
idx = FilePath -> Opt
PkgIndex (FilePath -> Opt) -> FilePath -> Opt
forall a b. (a -> b) -> a -> b
$ case (Opt -> Maybe FilePath) -> [Opt] -> [FilePath]
forall a. (Opt -> Maybe a) -> [Opt] -> [a]
opt Opt -> Maybe FilePath
getIBCSubDir [Opt]
copts of
(FilePath
ibcsubdir:[FilePath]
_) -> FilePath
ibcsubdir FilePath -> FilePath -> FilePath
</> FilePath
idx'
[] -> FilePath
idx'
[Bool]
oks <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> PkgName -> FilePath -> IO Bool
testLib Bool
warnonly (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)) (PkgDesc -> [FilePath]
libdeps PkgDesc
pkgdesc)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
oks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe IState
m_ist <- PkgDesc -> IO (Maybe IState) -> IO (Maybe IState)
forall a. PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc (IO (Maybe IState) -> IO (Maybe IState))
-> IO (Maybe IState) -> IO (Maybe IState)
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath -> IO ()
make (PkgDesc -> Maybe FilePath
makefile PkgDesc
pkgdesc)
case (PkgDesc -> Maybe FilePath
execout PkgDesc
pkgdesc) of
Maybe FilePath
Nothing -> do
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts (Opt
idx Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose Int
1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Opt]
opts -> do
Bool -> PkgDesc -> IO ()
auditPackage (Opt
AuditIPkg Opt -> [Opt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opt]
opts) PkgDesc
pkgdesc
[Opt] -> [Name] -> IO (Maybe IState)
buildMods [Opt]
opts (PkgDesc -> [Name]
modules PkgDesc
pkgdesc)
Just FilePath
o -> do
let exec :: FilePath
exec = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
o
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts (Opt
idx Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose Int
1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: FilePath -> Opt
Output FilePath
exec Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Opt]
opts -> do
Bool -> PkgDesc -> IO ()
auditPackage (Opt
AuditIPkg Opt -> [Opt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opt]
opts) PkgDesc
pkgdesc
[Opt] -> Maybe Name -> IO (Maybe IState)
buildMain [Opt]
opts (PkgDesc -> Maybe Name
idris_main PkgDesc
pkgdesc)
case Maybe IState
m_ist of
Maybe IState
Nothing -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Just IState
ist -> do
case IState -> Maybe FC
errSpan IState
ist of
Just FC
_ -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Maybe FC
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
install (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> PkgDesc -> IO ()
installPkg ((Opt -> Maybe FilePath) -> [Opt] -> [FilePath]
forall a. (Opt -> Maybe a) -> [Opt] -> [a]
opt Opt -> Maybe FilePath
getIBCSubDir [Opt]
copts) PkgDesc
pkgdesc
where
buildMain :: [Opt] -> Maybe Name -> IO (Maybe IState)
buildMain [Opt]
opts (Just Name
mod) = [Opt] -> [Name] -> IO (Maybe IState)
buildMods [Opt]
opts [Name
mod]
buildMain [Opt]
_ Maybe Name
Nothing = do
FilePath -> IO ()
putStrLn FilePath
"Can't build an executable: No main module given"
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
checkPkg :: [Opt]
-> Bool
-> Bool
-> FilePath
-> IO ()
checkPkg :: [Opt] -> Bool -> Bool -> FilePath -> IO ()
checkPkg [Opt]
copts Bool
warnonly Bool
quit FilePath
fpath = do
PkgDesc
pkgdesc <- FilePath -> IO PkgDesc
parseDesc FilePath
fpath
[Bool]
oks <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> PkgName -> FilePath -> IO Bool
testLib Bool
warnonly (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)) (PkgDesc -> [FilePath]
libdeps PkgDesc
pkgdesc)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
oks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe IState
res <- PkgDesc -> IO (Maybe IState) -> IO (Maybe IState)
forall a. PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc (IO (Maybe IState) -> IO (Maybe IState))
-> IO (Maybe IState) -> IO (Maybe IState)
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath -> IO ()
make (PkgDesc -> Maybe FilePath
makefile PkgDesc
pkgdesc)
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts (Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose Int
1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Opt]
opts -> do
Bool -> PkgDesc -> IO ()
auditPackage (Opt
AuditIPkg Opt -> [Opt] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opt]
opts) PkgDesc
pkgdesc
[Opt] -> [Name] -> IO (Maybe IState)
buildMods [Opt]
opts (PkgDesc -> [Name]
modules PkgDesc
pkgdesc)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
quit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe IState
res of
Maybe IState
Nothing -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Just IState
res' -> do
case IState -> Maybe FC
errSpan IState
res' of
Just FC
_ -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Maybe FC
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
replPkg :: [Opt]
-> FilePath
-> Idris ()
replPkg :: [Opt] -> FilePath -> Idris ()
replPkg [Opt]
copts FilePath
fp = do
IState
orig <- Idris IState
getIState
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ [Opt] -> Bool -> Bool -> FilePath -> IO ()
checkPkg [Opt]
copts Bool
False Bool
False FilePath
fp
PkgDesc
pkgdesc <- IO PkgDesc -> Idris PkgDesc
forall a. IO a -> Idris a
runIO (IO PkgDesc -> Idris PkgDesc) -> IO PkgDesc -> Idris PkgDesc
forall a b. (a -> b) -> a -> b
$ FilePath -> IO PkgDesc
parseDesc FilePath
fp
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts (PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left FilePath
emsg -> FilePath -> Idris ()
forall a. FilePath -> Idris a
ifail FilePath
emsg
Right [Opt]
opts -> do
IState -> Idris ()
putIState IState
orig
FilePath
dir <- IO FilePath -> Idris FilePath
forall a. IO a -> Idris a
runIO IO FilePath
getCurrentDirectory
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
setCurrentDirectory (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc
[Opt] -> Maybe Name -> Idris ()
runMain [Opt]
opts (PkgDesc -> Maybe Name
idris_main PkgDesc
pkgdesc)
IO () -> Idris ()
forall a. IO a -> Idris a
runIO (IO () -> Idris ()) -> IO () -> Idris ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
setCurrentDirectory FilePath
dir
where
toPath :: FilePath -> FilePath
toPath FilePath
n = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"." FilePath
n
runMain :: [Opt] -> Maybe Name -> Idris ()
runMain [Opt]
opts (Just Name
mod) = do
let f :: FilePath
f = FilePath -> FilePath
toPath (Name -> FilePath
showCG Name
mod)
[Opt] -> Idris ()
idrisMain ((FilePath -> Opt
Filename FilePath
f) Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: [Opt]
opts)
runMain [Opt]
_ Maybe Name
Nothing =
FilePath -> Idris ()
iputStrLn FilePath
"Can't start REPL: no main module given"
cleanPkg :: [Opt]
-> FilePath
-> IO ()
cleanPkg :: [Opt] -> FilePath -> IO ()
cleanPkg [Opt]
copts FilePath
fp = do
PkgDesc
pkgdesc <- FilePath -> IO PkgDesc
parseDesc FilePath
fp
FilePath
dir <- IO FilePath
getCurrentDirectory
PkgDesc -> IO () -> IO ()
forall a. PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath -> IO ()
clean (PkgDesc -> Maybe FilePath
makefile PkgDesc
pkgdesc)
(Name -> IO ()) -> [Name] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Name -> IO ()
rmIBC (PkgDesc -> [Name]
modules PkgDesc
pkgdesc)
PkgName -> IO ()
rmIdx (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)
case PkgDesc -> Maybe FilePath
execout PkgDesc
pkgdesc of
Maybe FilePath
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
s -> FilePath -> IO ()
rmExe (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
s
documentPkg :: [Opt]
-> (Bool,FilePath)
-> IO ()
documentPkg :: [Opt] -> (Bool, FilePath) -> IO ()
documentPkg [Opt]
copts (Bool
install,FilePath
fp) = do
PkgDesc
pkgdesc <- FilePath -> IO PkgDesc
parseDesc FilePath
fp
FilePath
cd <- IO FilePath
getCurrentDirectory
let pkgDir :: FilePath
pkgDir = FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeDirectory FilePath
fp
outputDir :: FilePath
outputDir = FilePath
cd FilePath -> FilePath -> FilePath
</> PkgName -> FilePath
unPkgName (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_doc"
popts :: [Opt]
popts = Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose Int
1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc
mods :: [Name]
mods = PkgDesc -> [Name]
modules PkgDesc
pkgdesc
fs :: [FilePath]
fs = (Name -> FilePath) -> [Name] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> FilePath)
-> (Name -> [FilePath]) -> Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"." (FilePath -> [FilePath])
-> (Name -> FilePath) -> Name -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
showCG) [Name]
mods
FilePath -> IO ()
setCurrentDirectory (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
pkgDir FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc
Maybe FilePath -> IO ()
make (PkgDesc -> Maybe FilePath
makefile PkgDesc
pkgdesc)
FilePath -> IO ()
setCurrentDirectory FilePath
pkgDir
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts [Opt]
popts of
Left FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Opt]
opts -> do
let run :: StateT a (ExceptT e m) a -> a -> m (Either e a)
run StateT a (ExceptT e m) a
l = ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m a -> m (Either e a))
-> (a -> ExceptT e m a) -> a -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT a (ExceptT e m) a -> a -> ExceptT e m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT a (ExceptT e m) a
l
load :: [FilePath] -> Idris ()
load [] = () -> Idris ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
load (FilePath
f:[FilePath]
fs) = do FilePath -> IBCPhase -> Idris (Maybe FilePath)
loadModule FilePath
f IBCPhase
IBC_Building; [FilePath] -> Idris ()
load [FilePath]
fs
loader :: Idris ()
loader = do
[Opt] -> Idris ()
idrisMain [Opt]
opts
FilePath -> Idris ()
addImportDir (PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc)
[FilePath] -> Idris ()
load [FilePath]
fs
Either Err IState
idrisImplementation <- Idris () -> IState -> IO (Either Err IState)
forall (m :: * -> *) a e a.
Monad m =>
StateT a (ExceptT e m) a -> a -> m (Either e a)
run Idris ()
loader IState
idrisInit
FilePath -> IO ()
setCurrentDirectory FilePath
cd
case Either Err IState
idrisImplementation of
Left Err
err -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ IState -> Err -> FilePath
pshow IState
idrisInit Err
err
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right IState
ist -> do
FilePath
iDocDir <- IO FilePath
getIdrisDocDir
FilePath
pkgDocDir <- FilePath -> IO FilePath
makeAbsolute (FilePath
iDocDir FilePath -> FilePath -> FilePath
</> PkgName -> FilePath
unPkgName (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc))
let out_dir :: FilePath
out_dir = if Bool
install then FilePath
pkgDocDir else FilePath
outputDir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
install (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Attempting to install IdrisDocs for", PkgName -> FilePath
forall a. Show a => a -> FilePath
show (PkgName -> FilePath) -> PkgName -> FilePath
forall a b. (a -> b) -> a -> b
$ PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc, FilePath
"in:", FilePath
out_dir]
Either FilePath ()
docRes <- IState -> [Name] -> FilePath -> IO (Either FilePath ())
generateDocs IState
ist [Name]
mods FilePath
out_dir
case Either FilePath ()
docRes of
Right ()
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left FilePath
msg -> do
FilePath -> IO ()
putStrLn FilePath
msg
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
testPkg :: [Opt]
-> FilePath
-> IO ExitCode
testPkg :: [Opt] -> FilePath -> IO ExitCode
testPkg [Opt]
copts FilePath
fp = do
PkgDesc
pkgdesc <- FilePath -> IO PkgDesc
parseDesc FilePath
fp
[Bool]
ok <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> PkgName -> FilePath -> IO Bool
testLib Bool
True (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)) (PkgDesc -> [FilePath]
libdeps PkgDesc
pkgdesc)
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
ok
then do
(Maybe IState
m_ist, ExitCode
exitCode) <- PkgDesc
-> IO (Maybe IState, ExitCode) -> IO (Maybe IState, ExitCode)
forall a. PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc (IO (Maybe IState, ExitCode) -> IO (Maybe IState, ExitCode))
-> IO (Maybe IState, ExitCode) -> IO (Maybe IState, ExitCode)
forall a b. (a -> b) -> a -> b
$ do
Maybe FilePath -> IO ()
make (PkgDesc -> Maybe FilePath
makefile PkgDesc
pkgdesc)
(FilePath
tmpn, Handle
tmph) <- FilePath -> IO (FilePath, Handle)
tempfile FilePath
".idr"
Handle -> FilePath -> IO ()
hPutStrLn Handle
tmph (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"module Test_______\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
[FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath
"import " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" | Name
m <- PkgDesc -> [Name]
modules PkgDesc
pkgdesc]
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"namespace Main\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" main : IO ()\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" main = do "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Name -> FilePath
forall a. Show a => a -> FilePath
show Name
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n "
| Name
t <- PkgDesc -> [Name]
idris_tests PkgDesc
pkgdesc]
Handle -> IO ()
hClose Handle
tmph
(FilePath
tmpn', Handle
tmph') <- FilePath -> IO (FilePath, Handle)
tempfile FilePath
""
Handle -> IO ()
hClose Handle
tmph'
let popts :: [Opt]
popts = (FilePath -> Opt
Filename FilePath
tmpn Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose Int
1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: FilePath -> Opt
Output FilePath
tmpn' Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc)
case [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts [Opt]
popts of
Left FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState, ExitCode)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right [Opt]
opts -> do
Maybe IState
m_ist <- [Opt] -> IO (Maybe IState)
idris [Opt]
opts
let texe :: FilePath
texe = if Bool
isWindows then FilePath -> FilePath -> FilePath
addExtension FilePath
tmpn' FilePath
".exe" else FilePath
tmpn'
ExitCode
exitCode <- FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
texe []
(Maybe IState, ExitCode) -> IO (Maybe IState, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IState
m_ist, ExitCode
exitCode)
case Maybe IState
m_ist of
Maybe IState
Nothing -> ExitCode -> IO ExitCode
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Just IState
ist -> do
case IState -> Maybe FC
errSpan IState
ist of
Just FC
_ -> ExitCode -> IO ExitCode
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Maybe FC
_ -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode
else ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1)
installPkg :: [String]
-> PkgDesc
-> IO ()
installPkg :: [FilePath] -> PkgDesc -> IO ()
installPkg [FilePath]
altdests PkgDesc
pkgdesc = PkgDesc -> IO () -> IO ()
forall a. PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath
d <- IO FilePath
getIdrisLibDir
let destdir :: FilePath
destdir = case [FilePath]
altdests of
[] -> FilePath
d
(FilePath
d':[FilePath]
_) -> FilePath
d'
case (PkgDesc -> Maybe FilePath
execout PkgDesc
pkgdesc) of
Maybe FilePath
Nothing -> do
(Name -> IO ()) -> [Name] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> PkgName -> Name -> IO ()
installIBC FilePath
destdir (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)) (PkgDesc -> [Name]
modules PkgDesc
pkgdesc)
FilePath -> PkgName -> IO ()
installIdx FilePath
destdir (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)
Just FilePath
o -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> PkgName -> FilePath -> IO ()
installObj FilePath
destdir (PkgDesc -> PkgName
pkgname PkgDesc
pkgdesc)) (PkgDesc -> [FilePath]
objs PkgDesc
pkgdesc)
auditPackage :: Bool -> PkgDesc -> IO ()
auditPackage :: Bool -> PkgDesc -> IO ()
auditPackage Bool
False PkgDesc
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
auditPackage Bool
True PkgDesc
ipkg = do
FilePath
cwd <- IO FilePath
getCurrentDirectory
let ms :: [FilePath]
ms = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PkgDesc -> FilePath
sourcedir PkgDesc
ipkg FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Name -> FilePath) -> [Name] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
toPath (FilePath -> FilePath) -> (Name -> FilePath) -> Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
showCG) (PkgDesc -> [Name]
modules PkgDesc
ipkg)
[FilePath]
ms' <- (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
makeAbsolute [FilePath]
ms
[FilePath]
ifiles <- FilePath -> IO [FilePath]
getIdrisFiles FilePath
cwd
let ifiles' :: [FilePath]
ifiles' = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropExtension [FilePath]
ifiles
[FilePath]
not_listed <- (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
makeRelativeToCurrentDirectory ([FilePath]
ifiles' [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ms')
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
[FilePath
"Warning: The following modules are not listed in your iPkg file:\n"]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
m -> [FilePath] -> FilePath
unwords [FilePath
"-", FilePath
m]) [FilePath]
not_listed
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"\nModules that are not listed, are not installed."]
where
toPath :: FilePath -> FilePath
toPath FilePath
n = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"." FilePath
n
getIdrisFiles :: FilePath -> IO [FilePath]
getIdrisFiles :: FilePath -> IO [FilePath]
getIdrisFiles FilePath
dir = do
[FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[[FilePath]]
files <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
contents (FilePath -> FilePath -> IO [FilePath]
findRest FilePath
dir)
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> Bool
isIdrisFile) ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
files)
isIdrisFile :: FilePath -> Bool
isIdrisFile :: FilePath -> Bool
isIdrisFile FilePath
fp = FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".idr" Bool -> Bool -> Bool
|| FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".lidr"
findRest :: FilePath -> FilePath -> IO [FilePath]
findRest :: FilePath -> FilePath -> IO [FilePath]
findRest FilePath
dir FilePath
fn = do
FilePath
path <- FilePath -> IO FilePath
makeAbsolute (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
fn)
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
if Bool
isDir
then FilePath -> IO [FilePath]
getIdrisFiles FilePath
path
else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path]
buildMods :: [Opt] -> [Name] -> IO (Maybe IState)
buildMods :: [Opt] -> [Name] -> IO (Maybe IState)
buildMods [Opt]
opts [Name]
ns = do let f :: [FilePath]
f = (Name -> FilePath) -> [Name] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
toPath (FilePath -> FilePath) -> (Name -> FilePath) -> Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
showCG) [Name]
ns
[Opt] -> IO (Maybe IState)
idris ((FilePath -> Opt) -> [FilePath] -> [Opt]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Opt
Filename [FilePath]
f [Opt] -> [Opt] -> [Opt]
forall a. [a] -> [a] -> [a]
++ [Opt]
opts)
where
toPath :: FilePath -> FilePath
toPath FilePath
n = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"." FilePath
n
testLib :: Bool -> PkgName -> String -> IO Bool
testLib :: Bool -> PkgName -> FilePath -> IO Bool
testLib Bool
warn PkgName
p FilePath
f
= do FilePath
d <- IO FilePath
getIdrisCRTSDir
FilePath
gcc <- IO FilePath
getCC
(FilePath
tmpf, Handle
tmph) <- FilePath -> IO (FilePath, Handle)
tempfile FilePath
""
Handle -> IO ()
hClose Handle
tmph
let libtest :: FilePath
libtest = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"libtest.c"
ExitCode
e <- FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
gcc [FilePath
libtest, FilePath
"-l" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f, FilePath
"-o", FilePath
tmpf]
case ExitCode
e of
ExitCode
ExitSuccess -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
ExitCode
_ -> do if Bool
warn
then do FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Not building " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PkgName -> FilePath
forall a. Show a => a -> FilePath
show PkgName
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" due to missing library " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else FilePath -> IO Bool
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing library " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
rmIBC :: Name -> IO ()
rmIBC :: Name -> IO ()
rmIBC Name
m = FilePath -> IO ()
rmFile (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
toIBCFile Name
m
rmIdx :: PkgName -> IO ()
rmIdx :: PkgName -> IO ()
rmIdx PkgName
p = do let f :: FilePath
f = PkgName -> FilePath
pkgIndex PkgName
p
Bool
ex <- FilePath -> IO Bool
doesFileExist FilePath
f
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ex (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
rmFile FilePath
f
rmExe :: String -> IO ()
rmExe :: FilePath -> IO ()
rmExe FilePath
p = do
FilePath
fn <- FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if Bool
isWindows Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasExtension FilePath
p)
then FilePath -> FilePath -> FilePath
addExtension FilePath
p FilePath
".exe" else FilePath
p
FilePath -> IO ()
rmFile FilePath
fn
toIBCFile :: Name -> FilePath
toIBCFile (UN Text
n) = Text -> FilePath
str Text
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".ibc"
toIBCFile (NS Name
n [Text]
ns) = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse (Name -> FilePath
toIBCFile Name
n FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
str [Text]
ns))
installIBC :: String -> PkgName -> Name -> IO ()
installIBC :: FilePath -> PkgName -> Name -> IO ()
installIBC FilePath
dest PkgName
p Name
m = do
let f :: FilePath
f = Name -> FilePath
toIBCFile Name
m
let destdir :: FilePath
destdir = FilePath
dest FilePath -> FilePath -> FilePath
</> PkgName -> FilePath
unPkgName PkgName
p FilePath -> FilePath -> FilePath
</> Name -> FilePath
getDest Name
m
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destdir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
destdir
FilePath -> FilePath -> IO ()
copyFile FilePath
f (FilePath
destdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
f)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
getDest :: Name -> FilePath
getDest (UN Text
n) = FilePath
""
getDest (NS Name
n [Text]
ns) = (FilePath -> FilePath -> FilePath) -> [FilePath] -> FilePath
forall a. (a -> a -> a) -> [a] -> a
foldl1' FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse (Name -> FilePath
getDest Name
n FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
str [Text]
ns))
installIdx :: String -> PkgName -> IO ()
installIdx :: FilePath -> PkgName -> IO ()
installIdx FilePath
dest PkgName
p = do
let f :: FilePath
f = PkgName -> FilePath
pkgIndex PkgName
p
let destdir :: FilePath
destdir = FilePath
dest FilePath -> FilePath -> FilePath
</> PkgName -> FilePath
unPkgName PkgName
p
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destdir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
destdir
FilePath -> FilePath -> IO ()
copyFile FilePath
f (FilePath
destdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
f)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
installObj :: String -> PkgName -> String -> IO ()
installObj :: FilePath -> PkgName -> FilePath -> IO ()
installObj FilePath
dest PkgName
p FilePath
o = do
let destdir :: FilePath
destdir = FilePath -> FilePath
addTrailingPathSeparator (FilePath
dest FilePath -> FilePath -> FilePath
</> PkgName -> FilePath
unPkgName PkgName
p)
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destdir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
destdir
FilePath -> FilePath -> IO ()
copyFile FilePath
o (FilePath
destdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
o)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#ifdef mingw32_HOST_OS
mkDirCmd = "mkdir "
#else
mkDirCmd :: FilePath
mkDirCmd = FilePath
"mkdir -p "
#endif
inPkgDir :: PkgDesc -> IO a -> IO a
inPkgDir :: PkgDesc -> IO a -> IO a
inPkgDir PkgDesc
pkgdesc IO a
action =
do FilePath
dir <- IO FilePath
getCurrentDirectory
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Entering directory `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
"." FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
FilePath -> IO ()
setCurrentDirectory (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc
a
res <- IO a
action
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Leaving directory `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
"." FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
FilePath -> IO ()
setCurrentDirectory FilePath
dir
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
makeTarget :: Maybe String -> Maybe String -> IO ()
makeTarget :: Maybe FilePath -> Maybe FilePath -> IO ()
makeTarget Maybe FilePath
_ Maybe FilePath
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
makeTarget Maybe FilePath
mtgt (Just FilePath
s) = do FilePath
incFlags <- FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ([FilePath] -> FilePath) -> IO [FilePath] -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
getIncFlags
FilePath
libFlags <- FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ([FilePath] -> FilePath) -> IO [FilePath] -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
getLibFlags
[(FilePath, FilePath)]
newEnv <- ([(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath
"IDRIS_INCLUDES", FilePath
incFlags),
(FilePath
"IDRIS_LDFLAGS", FilePath
libFlags)]) ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(FilePath, FilePath)]
getEnvironment
let cmdLine :: FilePath
cmdLine = case Maybe FilePath
mtgt of
Maybe FilePath
Nothing -> FilePath
"make -f " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
Just FilePath
tgt -> FilePath
"make -f " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tgt
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
r) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (FilePath -> CreateProcess
shell FilePath
cmdLine) { env :: Maybe [(FilePath, FilePath)]
env = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
newEnv }
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
r
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
make :: Maybe String -> IO ()
make :: Maybe FilePath -> IO ()
make = Maybe FilePath -> Maybe FilePath -> IO ()
makeTarget Maybe FilePath
forall a. Maybe a
Nothing
clean :: Maybe String -> IO ()
clean :: Maybe FilePath -> IO ()
clean = Maybe FilePath -> Maybe FilePath -> IO ()
makeTarget (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"clean")
mergeOptions :: [Opt]
-> [Opt]
-> Either String [Opt]
mergeOptions :: [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions [Opt]
copts [Opt]
popts =
case [Either FilePath Opt] -> ([FilePath], [Opt])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ((Opt -> Either FilePath Opt) -> [Opt] -> [Either FilePath Opt]
forall a b. (a -> b) -> [a] -> [b]
map Opt -> Either FilePath Opt
chkOpt ([Opt] -> [Opt]
normaliseOpts [Opt]
copts)) of
([], [Opt]
copts') -> [Opt] -> Either FilePath [Opt]
forall a b. b -> Either a b
Right ([Opt] -> Either FilePath [Opt]) -> [Opt] -> Either FilePath [Opt]
forall a b. (a -> b) -> a -> b
$ [Opt]
copts' [Opt] -> [Opt] -> [Opt]
forall a. [a] -> [a] -> [a]
++ [Opt]
popts
([FilePath]
es, [Opt]
_) -> FilePath -> Either FilePath [Opt]
forall a b. a -> Either a b
Left (FilePath -> Either FilePath [Opt])
-> FilePath -> Either FilePath [Opt]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
genErrMsg [FilePath]
es
where
normaliseOpts :: [Opt] -> [Opt]
normaliseOpts :: [Opt] -> [Opt]
normaliseOpts = (Opt -> Bool) -> [Opt] -> [Opt]
forall a. (a -> Bool) -> [a] -> [a]
filter Opt -> Bool
filtOpt
filtOpt :: Opt -> Bool
filtOpt :: Opt -> Bool
filtOpt (PkgBuild FilePath
_) = Bool
False
filtOpt (PkgInstall FilePath
_) = Bool
False
filtOpt (PkgClean FilePath
_) = Bool
False
filtOpt (PkgCheck FilePath
_) = Bool
False
filtOpt (PkgREPL FilePath
_) = Bool
False
filtOpt (PkgDocBuild FilePath
_) = Bool
False
filtOpt (PkgDocInstall FilePath
_) = Bool
False
filtOpt (PkgTest FilePath
_) = Bool
False
filtOpt Opt
_ = Bool
True
chkOpt :: Opt -> Either String Opt
chkOpt :: Opt -> Either FilePath Opt
chkOpt o :: Opt
o@(OLogging Int
_) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(OLogCats [LogCat]
_) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
DefaultTotal) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
DefaultPartial) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
WarnPartial) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
WarnReach) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(IBCSubDir FilePath
_) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(ImportDir FilePath
_ ) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(UseCodegen Codegen
_) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Verbose Int
_) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
AuditIPkg) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Opt
DumpHighlights) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt Opt
o = FilePath -> Either FilePath Opt
forall a b. a -> Either a b
Left ([FilePath] -> FilePath
unwords [FilePath
"\t", Opt -> FilePath
forall a. Show a => a -> FilePath
show Opt
o, FilePath
"\n"])
genErrMsg :: [String] -> String
genErrMsg :: [FilePath] -> FilePath
genErrMsg [FilePath]
es = [FilePath] -> FilePath
unlines
[ FilePath
"Not all command line options can be used to override package options."
, FilePath
"\nThe only changeable options are:"
, FilePath
"\t--log <lvl>, --total, --warnpartial, --warnreach, --warnipkg"
, FilePath
"\t--ibcsubdir <path>, -i --idrispath <path>"
, FilePath
"\t--logging-categories <cats>"
, FilePath
"\t--highlight"
, FilePath
"\nThe options need removing are:"
, [FilePath] -> FilePath
unlines [FilePath]
es
]