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