@@ -8,6 +8,26 @@ Maintainer : The Idris Community.
88{-# LANGUAGE CPP #-}
99module Idris.Package where
1010
11+import System.Directory
12+import System.Directory (copyFile, createDirectoryIfMissing)
13+import System.Exit
14+import System.FilePath (addExtension, addTrailingPathSeparator, dropExtension,
15+ hasExtension, normalise, takeDirectory, takeExtension,
16+ takeFileName, (</>))
17+import System.IO
18+import System.Process
19+
20+import Util.System
21+
22+import Control.Monad
23+import Control.Monad.Trans.Except (runExceptT)
24+import Control.Monad.Trans.State.Strict (execStateT)
25+import Data.Either (partitionEithers)
26+import Data.Either (partitionEithers)
27+import Data.List
28+import Data.List.Split (splitOn)
29+import Data.Maybe (fromMaybe)
30+
1131import Idris.AbsSyntax
1232import Idris.Core.TT
1333import Idris.Error (ifail)
@@ -17,28 +37,13 @@ import Idris.Imports
1737import Idris.Main (idris, idrisMain)
1838import Idris.Output (pshow)
1939import Idris.Output
20−import Idris.Package.Common
21−import Idris.Package.Parser
2240import Idris.Parser (loadModule)
2341import Idris.REPL
24−import IRTS.System
2542
26−import Util.System
43+import Idris.Package.Common
44+import Idris.Package.Parser
2745
28−import Control.Monad
29−import Control.Monad.Trans.Except (runExceptT)
30−import Control.Monad.Trans.State.Strict (execStateT)
31−import Data.Either (partitionEithers)
32−import Data.List
33−import Data.List.Split (splitOn)
34−import Data.Maybe (fromMaybe)
35−import System.Directory
36−import System.Directory (copyFile, createDirectoryIfMissing)
37−import System.Exit
38−import System.FilePath (addExtension, addTrailingPathSeparator, hasExtension,
39− normalise, takeDirectory, takeFileName, (</>))
40−import System.IO
41−import System.Process
46+import IRTS.System
4247
4348-- To build a package:
4449-- * read the package description
@@ -75,14 +80,18 @@ buildPkg copts warnonly (install, fp) = do
7580 Left emsg -> do
7681 putStrLn emsg
7782 exitWith (ExitFailure 1)
78− Right opts -> buildMods opts (modules pkgdesc)
83+ Right opts -> do
84+ auditPackage (AuditIPkg `elem` opts) pkgdesc
85+ buildMods opts (modules pkgdesc)
7986 Just o -> do
8087 let exec = dir </> o
8188 case mergeOptions copts (idx : NoREPL : Verbose 1 : Output exec : idris_opts pkgdesc) of
8289 Left emsg -> do
8390 putStrLn emsg
8491 exitWith (ExitFailure 1)
85− Right opts -> buildMain opts (idris_main pkgdesc)
92+ Right opts -> do
93+ auditPackage (AuditIPkg `elem` opts) pkgdesc
94+ buildMain opts (idris_main pkgdesc)
8695 case m_ist of
8796 Nothing -> exitWith (ExitFailure 1)
8897 Just ist -> do
@@ -120,6 +129,7 @@ checkPkg copts warnonly quit fpath = do
120129 putStrLn emsg
121130 exitWith (ExitFailure 1)
122131 Right opts -> do
132+ auditPackage (AuditIPkg `elem` opts) pkgdesc
123133 buildMods opts (modules pkgdesc)
124134 when quit $ case res of
125135 Nothing -> exitWith (ExitFailure 1)
@@ -301,10 +311,55 @@ installPkg altdests pkgdesc = inPkgDir pkgdesc $ do
301311-- Methods for building, testing, installing, and removal of idris
302312-- packages.
303313
314+auditPackage :: Bool -> PkgDesc -> IO ()
315+auditPackage False _ = return ()
316+auditPackage True ipkg = do
317+ cwd <- getCurrentDirectory
318+
319+ let ms = map (sourcedir ipkg </>) $ map (toPath . showCG) (modules ipkg)
320+ ms' <- mapM makeAbsolute ms
321+
322+ ifiles <- getIdrisFiles cwd
323+
324+ let ifiles' = map dropExtension ifiles
325+
326+ not_listed <- mapM makeRelativeToCurrentDirectory (ifiles' \\ ms')
327+
328+ putStrLn $ unlines $
329+ ["Warning: The following modules are not listed in your iPkg file:\n"]
330+ ++ map (\m -> unwords ["-", m]) not_listed
331+ ++ ["\nModules that are not listed, are not installed."]
332+
333+ where
334+ toPath n = foldl1' (</>) $ splitOn "." n
335+
336+ getIdrisFiles :: FilePath -> IO [FilePath]
337+ getIdrisFiles dir = do
338+ contents <- getDirectoryContents dir
339+ let contents' = filter (\fname -> fname /= "." && fname /= "..") contents
340+
341+ -- [ 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.
342+
343+
344+ files <- forM contents (findRest dir)
345+ return $ filter (isIdrisFile) (concat files)
346+
347+ isIdrisFile :: FilePath -> Bool
348+ isIdrisFile fp = takeExtension fp == ".idr" || takeExtension fp == ".lidr"
349+
350+ findRest :: FilePath -> FilePath -> IO [FilePath]
351+ findRest dir fn = do
352+ path <- makeAbsolute (dir </> fn)
353+ isDir <- doesDirectoryExist path
354+ if isDir
355+ then getIdrisFiles path
356+ else return [path]
357+
304358buildMods :: [Opt] -> [Name] -> IO (Maybe IState)
305359buildMods opts ns = do let f = map (toPath . showCG) ns
306360 idris (map Filename f ++ opts)
307− where toPath n = foldl1' (</>) $ splitOn "." n
361+ where
362+ toPath n = foldl1' (</>) $ splitOn "." n
308363
309364testLib :: Bool -> String -> String -> IO Bool
310365testLib warn p f
@@ -443,13 +498,14 @@ mergeOptions copts popts =
443498 chkOpt o@(ImportDir _ ) = Right o
444499 chkOpt o@(UseCodegen _) = Right o
445500 chkOpt o@(Verbose _) = Right o
501+ chkOpt o@(AuditIPkg) = Right o
446502 chkOpt o = Left (unwords ["\t", show o, "\n"])
447503
448504 genErrMsg :: [String] -> String
449505 genErrMsg es = unlines
450506 [ "Not all command line options can be used to override package options."
451507 , "\nThe only changeable options are:"
452− , "\t--log <lvl>, --total, --warnpartial, --warnreach"
508+ , "\t--log <lvl>, --total, --warnpartial, --warnreach, --warnipkg"
453509 , "\t--ibcsubdir <path>, -i --idrispath <path>"
454510 , "\t--logging-categories <cats>"
455511 , "\nThe options need removing are:"