{-# LANGUAGE CPP #-}
module Idris.Package where
import System.Directory
import System.Directory (copyFile, createDirectoryIfMissing)
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 copts :: [Opt]
copts warnonly :: Bool
warnonly (install :: Bool
install, fp :: 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
(ibcsubdir :: FilePath
ibcsubdir:_) -> 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
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 1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left emsg :: FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Right opts :: [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 o :: 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 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 emsg :: FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Right opts :: [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
Nothing -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Just ist :: IState
ist -> do
case IState -> Maybe FC
errSpan IState
ist of
Just _ -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
_ -> () -> 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 opts :: [Opt]
opts (Just mod :: Name
mod) = [Opt] -> [Name] -> IO (Maybe IState)
buildMods [Opt]
opts [Name
mod]
buildMain _ Nothing = do
FilePath -> IO ()
putStrLn "Can't build an executable: No main module given"
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
checkPkg :: [Opt]
-> Bool
-> Bool
-> FilePath
-> IO ()
checkPkg :: [Opt] -> Bool -> Bool -> FilePath -> IO ()
checkPkg copts :: [Opt]
copts warnonly :: Bool
warnonly quit :: Bool
quit fpath :: 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 1 Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: PkgDesc -> [Opt]
idris_opts PkgDesc
pkgdesc) of
Left emsg :: FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Right opts :: [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
Nothing -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Just res' :: IState
res' -> do
case IState -> Maybe FC
errSpan IState
res' of
Just _ -> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
replPkg :: [Opt]
-> FilePath
-> Idris ()
replPkg :: [Opt] -> FilePath -> Idris ()
replPkg copts :: [Opt]
copts fp :: 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 emsg :: FilePath
emsg -> FilePath -> Idris ()
forall a. FilePath -> Idris a
ifail FilePath
emsg
Right opts :: [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 n :: 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
n
runMain :: [Opt] -> Maybe Name -> Idris ()
runMain opts :: [Opt]
opts (Just mod :: 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 _ Nothing =
FilePath -> Idris ()
iputStrLn "Can't start REPL: no main module given"
cleanPkg :: [Opt]
-> FilePath
-> IO ()
cleanPkg :: [Opt] -> FilePath -> IO ()
cleanPkg copts :: [Opt]
copts fp :: 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
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just s :: 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 copts :: [Opt]
copts (install :: Bool
install,fp :: 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]
++ "_doc"
popts :: [Opt]
popts = Opt
NoREPL Opt -> [Opt] -> [Opt]
forall a. a -> [a] -> [a]
: Int -> Opt
Verbose 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])
-> (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 emsg :: FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Right opts :: [Opt]
opts -> do
let run :: StateT a (ExceptT e m) a -> a -> m (Either e a)
run l :: 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 (f :: FilePath
f:fs :: [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
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 1)
Right ist :: 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 ["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, "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 msg :: FilePath
msg -> do
FilePath -> IO ()
putStrLn FilePath
msg
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
testPkg :: [Opt]
-> FilePath
-> IO ExitCode
testPkg :: [Opt] -> FilePath -> IO ExitCode
testPkg copts :: [Opt]
copts fp :: 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
(m_ist :: Maybe IState
m_ist, exitCode :: 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)
(tmpn :: FilePath
tmpn, tmph :: Handle
tmph) <- FilePath -> IO (FilePath, Handle)
tempfile ".idr"
Handle -> FilePath -> IO ()
hPutStrLn Handle
tmph (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
"module Test_______\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
[FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["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]
++ "\n" | Name
m <- PkgDesc -> [Name]
modules PkgDesc
pkgdesc]
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "namespace Main\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " main : IO ()\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " 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]
++ "\n "
| Name
t <- PkgDesc -> [Name]
idris_tests PkgDesc
pkgdesc]
Handle -> IO ()
hClose Handle
tmph
(tmpn' :: FilePath
tmpn', tmph' :: Handle
tmph') <- FilePath -> IO (FilePath, Handle)
tempfile ""
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 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 emsg :: FilePath
emsg -> do
FilePath -> IO ()
putStrLn FilePath
emsg
ExitCode -> IO (Maybe IState, ExitCode)
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Right opts :: [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' ".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
Nothing -> ExitCode -> IO ExitCode
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Just ist :: IState
ist -> do
case IState -> Maybe FC
errSpan IState
ist of
Just _ -> ExitCode -> IO ExitCode
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
_ -> 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 1)
installPkg :: [String]
-> PkgDesc
-> IO ()
installPkg :: [FilePath] -> PkgDesc -> IO ()
installPkg altdests :: [FilePath]
altdests pkgdesc :: 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
(d' :: FilePath
d':_) -> FilePath
d'
case (PkgDesc -> Maybe FilePath
execout PkgDesc
pkgdesc) of
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 o :: 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 False _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
auditPackage True ipkg :: 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
$
["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 (\m :: FilePath
m -> [FilePath] -> FilePath
unwords ["-", FilePath
m]) [FilePath]
not_listed
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["\nModules that are not listed, are not installed."]
where
toPath :: FilePath -> FilePath
toPath n :: 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
n
getIdrisFiles :: FilePath -> IO [FilePath]
getIdrisFiles :: FilePath -> IO [FilePath]
getIdrisFiles dir :: 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 fp :: FilePath
fp = FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".idr" Bool -> Bool -> Bool
|| FilePath -> FilePath
takeExtension FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".lidr"
findRest :: FilePath -> FilePath -> IO [FilePath]
findRest :: FilePath -> FilePath -> IO [FilePath]
findRest dir :: FilePath
dir fn :: 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 opts :: [Opt]
opts ns :: [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 n :: 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
n
testLib :: Bool -> PkgName -> String -> IO Bool
testLib :: Bool -> PkgName -> FilePath -> IO Bool
testLib warn :: Bool
warn p :: PkgName
p f :: FilePath
f
= do FilePath
d <- IO FilePath
getIdrisCRTSDir
FilePath
gcc <- IO FilePath
getCC
(tmpf :: FilePath
tmpf, tmph :: Handle
tmph) <- FilePath -> IO (FilePath, Handle)
tempfile ""
Handle -> IO ()
hClose Handle
tmph
let libtest :: FilePath
libtest = FilePath
d FilePath -> FilePath -> FilePath
</> "libtest.c"
ExitCode
e <- FilePath -> [FilePath] -> IO ExitCode
rawSystem FilePath
gcc [FilePath
libtest, "-l" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f, "-o", FilePath
tmpf]
case ExitCode
e of
ExitSuccess -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
_ -> do if Bool
warn
then do FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "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]
++
" 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
$ "Missing library " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
rmIBC :: Name -> IO ()
rmIBC :: Name -> IO ()
rmIBC m :: 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 p :: 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 p :: 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 ".exe" else FilePath
p
FilePath -> IO ()
rmFile FilePath
fn
toIBCFile :: Name -> FilePath
toIBCFile (UN n :: Text
n) = Text -> FilePath
str Text
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ".ibc"
toIBCFile (NS n :: Name
n ns :: [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 dest :: FilePath
dest p :: PkgName
p m :: 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
$ "Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " 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 n :: Text
n) = ""
getDest (NS n :: Name
n ns :: [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 dest :: FilePath
dest p :: 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
$ "Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " 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 dest :: FilePath
dest p :: PkgName
p o :: 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
$ "Installing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " 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 = "mkdir -p "
#endif
inPkgDir :: PkgDesc -> IO a -> IO a
inPkgDir :: PkgDesc -> IO a -> IO a
inPkgDir pkgdesc :: PkgDesc
pkgdesc action :: 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
/= "") (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
$ "Entering directory `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ("." FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'"
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
/= "") (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
$ "Leaving directory `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ("." FilePath -> FilePath -> FilePath
</> PkgDesc -> FilePath
sourcedir PkgDesc
pkgdesc) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'"
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 _ Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
makeTarget mtgt :: Maybe FilePath
mtgt (Just s :: FilePath
s) = do FilePath
incFlags <- FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate " " ([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) -> 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]
++ [("IDRIS_INCLUDES", FilePath
incFlags),
("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
Nothing -> "make -f " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
Just tgt :: FilePath
tgt -> "make -f " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tgt
(_, _, _, r :: 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 "clean")
mergeOptions :: [Opt]
-> [Opt]
-> Either String [Opt]
mergeOptions :: [Opt] -> [Opt] -> Either FilePath [Opt]
mergeOptions copts :: [Opt]
copts popts :: [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
([], copts' :: [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
(es :: [FilePath]
es, _) -> 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 _) = Bool
False
filtOpt (PkgInstall _) = Bool
False
filtOpt (PkgClean _) = Bool
False
filtOpt (PkgCheck _) = Bool
False
filtOpt (PkgREPL _) = Bool
False
filtOpt (PkgDocBuild _) = Bool
False
filtOpt (PkgDocInstall _) = Bool
False
filtOpt (PkgTest _) = Bool
False
filtOpt _ = Bool
True
chkOpt :: Opt -> Either String Opt
chkOpt :: Opt -> Either FilePath Opt
chkOpt o :: Opt
o@(OLogging _) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(OLogCats _) = 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 _) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(ImportDir _ ) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(UseCodegen _) = Opt -> Either FilePath Opt
forall a b. b -> Either a b
Right Opt
o
chkOpt o :: Opt
o@(Verbose _) = 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 o :: Opt
o = FilePath -> Either FilePath Opt
forall a b. a -> Either a b
Left ([FilePath] -> FilePath
unwords ["\t", Opt -> FilePath
forall a. Show a => a -> FilePath
show Opt
o, "\n"])
genErrMsg :: [String] -> String
genErrMsg :: [FilePath] -> FilePath
genErrMsg es :: [FilePath]
es = [FilePath] -> FilePath
unlines
[ "Not all command line options can be used to override package options."
, "\nThe only changeable options are:"
, "\t--log <lvl>, --total, --warnpartial, --warnreach, --warnipkg"
, "\t--ibcsubdir <path>, -i --idrispath <path>"
, "\t--logging-categories <cats>"
, "\t--highlight"
, "\nThe options need removing are:"
, [FilePath] -> FilePath
unlines [FilePath]
es
]