@@ -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,50 @@ 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 <- listDirectory dir
339+ files <- forM contents (findRest dir)
340+ return $ filter (isIdrisFile) (concat files)
341+
342+ isIdrisFile :: FilePath -> Bool
343+ isIdrisFile fp = takeExtension fp == ".idr" || takeExtension fp == ".lidr"
344+
345+ findRest :: FilePath -> FilePath -> IO [FilePath]
346+ findRest dir fn = do
347+ path <- makeAbsolute (dir </> fn)
348+ isDir <- doesDirectoryExist path
349+ if isDir
350+ then getIdrisFiles path
351+ else return [path]
352+
304353buildMods :: [Opt] -> [Name] -> IO (Maybe IState)
305354buildMods opts ns = do let f = map (toPath . showCG) ns
306355 idris (map Filename f ++ opts)
307− where toPath n = foldl1' (</>) $ splitOn "." n
356+ where
357+ toPath n = foldl1' (</>) $ splitOn "." n
308358
309359testLib :: Bool -> String -> String -> IO Bool
310360testLib warn p f
@@ -443,13 +493,14 @@ mergeOptions copts popts =
443493 chkOpt o@(ImportDir _ ) = Right o
444494 chkOpt o@(UseCodegen _) = Right o
445495 chkOpt o@(Verbose _) = Right o
496+ chkOpt o@(AuditIPkg) = Right o
446497 chkOpt o = Left (unwords ["\t", show o, "\n"])
447498
448499 genErrMsg :: [String] -> String
449500 genErrMsg es = unlines
450501 [ "Not all command line options can be used to override package options."
451502 , "\nThe only changeable options are:"
452− , "\t--log <lvl>, --total, --warnpartial, --warnreach"
503+ , "\t--log <lvl>, --total, --warnpartial, --warnreach, --warnipkg"
453504 , "\t--ibcsubdir <path>, -i --idrispath <path>"
454505 , "\t--logging-categories <cats>"
455506 , "\nThe options need removing are:"