{-|
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.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

-- 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 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
        -- Quit with error code if there was a problem
        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)

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

--  ------------------------------------------------------------------- [ 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 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 -- bzzt, repetition!

    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"

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

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

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

--  ------------------------------------------------------------------- [ 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 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)
        -- Get a temporary file to save the tests' source in
        (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
          -- Quit with error code if problem building
          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)

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

-- | Install package
installPkg :: [String]  -- ^ Alternate install location
           -> PkgDesc   -- ^ iPKG file.
           -> 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 () -- 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 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

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

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


-- | 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 "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 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
        ]

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