{-|
Module      : Idris.Package
Description : Functionality for working with Idris packages.

License     : BSD3
Maintainer  : The Idris Community.
-}
{-# 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

-- To build a package:
-- * read the package description
-- * check all the library dependencies exist
-- * invoke the makefile if there is one
-- * invoke idris on each module, with idris_opts
-- * install everything into datadir/pname, if install flag is set

getPkgDesc :: FilePath -> IO PkgDesc
getPkgDesc :: FilePath -> IO PkgDesc
getPkgDesc = FilePath -> IO PkgDesc
parseDesc

--  --------------------------------------------------------- [ Build Packages ]

-- | Run the package through the idris compiler.
buildPkg :: [Opt]            -- ^ Command line options
         -> Bool             -- ^ Provide Warnings
         -> (Bool, FilePath) -- ^ (Should we install, Location of iPKG file)
         -> 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
        -- Quit with error code if there was a problem
        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)

--  --------------------------------------------------------- [ Check Packages ]

-- | Type check packages only
--
-- This differs from build in that executables are not built, if the
-- package contains an executable.
checkPkg :: [Opt]     -- ^ Command line Options
         -> Bool      -- ^ Show Warnings
         -> Bool      -- ^ quit on failure
         -> FilePath  -- ^ Path to ipkg file.
         -> 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 ()

--  ------------------------------------------------------------------- [ REPL ]

-- | Check a package and start a REPL.
--
-- This function only works with packages that have a main module.
--
replPkg :: [Opt]    -- ^ Command line Options
        -> FilePath -- ^ Path to ipkg file.
        -> 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 -- bzzt, repetition!

    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"

--  --------------------------------------------------------------- [ Cleaning ]

-- | Clean Package build files
cleanPkg :: [Opt]    -- ^ Command line options.
         -> FilePath -- ^ Path to ipkg file.
         -> 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

--  ------------------------------------------------------ [ Generate IdrisDoc ]


-- | Generate IdrisDoc for package
-- TODO: Handle case where module does not contain a matching namespace
--       E.g. from prelude.ipkg: IO, Prelude.Chars, Builtins
--
-- Issue number #1572 on the issue tracker
--       https://github.com/idris-lang/Idris-dev/issues/1572
documentPkg :: [Opt]           -- ^ Command line options.
            -> (Bool,FilePath) -- ^ (Should we install?, Path to ipkg file).
            -> 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)

--  ------------------------------------------------------------------- [ Test ]

-- | Build a package with a sythesized main function that runs the tests
testPkg :: [Opt]     -- ^ Command line options.
        -> FilePath  -- ^ Path to ipkg file.
        -> 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)
        -- Get a temporary file to save the tests' source in
        (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
          -- Quit with error code if problem building
          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)

--  ----------------------------------------------------------- [ Installation ]

-- | Install package
installPkg :: [String]  -- ^ Alternate install location
           -> PkgDesc   -- ^ iPKG file.
           -> 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 () -- do nothing, keep executable locally, for noe

  (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)

-- ---------------------------------------------------------- [ Helper Methods ]
-- Methods for building, testing, installing, and removal of idris
-- packages.

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

      -- [ NOTE ] Directory >= 1.2.5.0 introduced `listDirectory` but later versions of directory appear to be causing problems with ghc 7.10.3 and cabal 1.22 in travis. Let's reintroduce the old ranges for directory to be sure.

      [[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

-- ------------------------------------------------------- [ Makefile Commands ]
-- | Invoke a Makefile's target with an enriched system environment
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 ()


-- | Invoke a Makefile's default target.
make :: Maybe String -> IO ()
make :: Maybe FilePath -> IO ()
make = Maybe FilePath -> Maybe FilePath -> IO ()
makeTarget Maybe FilePath
forall a. Maybe a
Nothing

-- | Invoke a Makefile's clean target.
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")

-- | Merge an option list representing the command line options into
-- those specified for a package description.
--
-- This is not a complete union between the two options sets. First,
-- to prevent important package specified options from being
-- overwritten. Second, the semantics for this merge are not fully
-- defined.
--
-- A discussion for this is on the issue tracker:
--     https://github.com/idris-lang/Idris-dev/issues/1448
--
mergeOptions :: [Opt] -- ^ The command line options
             -> [Opt] -- ^ The package options
             -> 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
        ]

-- --------------------------------------------------------------------- [ EOF ]