2010-03-11 10:03:17 +00:00
|
|
|
module List (listModules) where
|
|
|
|
|
|
|
|
import Control.Applicative
|
|
|
|
import Data.List
|
2010-03-11 13:39:07 +00:00
|
|
|
import Param
|
2010-03-11 10:03:17 +00:00
|
|
|
import System.IO
|
|
|
|
import System.Process
|
|
|
|
|
|
|
|
----------------------------------------------------------------
|
|
|
|
|
2010-03-11 13:39:07 +00:00
|
|
|
listModules :: Options -> IO String
|
|
|
|
listModules opt = convert opt . nub . sort . exposedModules <$> getDump opt
|
2010-03-11 10:03:17 +00:00
|
|
|
|
2010-03-11 13:39:07 +00:00
|
|
|
getDump :: Options -> IO String
|
|
|
|
getDump opt = do
|
|
|
|
(_,hout,_,_) <- runInteractiveProcess (ghcPkg opt) ["dump"] Nothing Nothing
|
2010-03-11 10:03:17 +00:00
|
|
|
hGetContents hout
|
|
|
|
|
|
|
|
exposedModules :: String -> [String]
|
2010-04-30 07:47:23 +00:00
|
|
|
exposedModules cs = concatMap words ms
|
2010-03-11 10:03:17 +00:00
|
|
|
where
|
|
|
|
ls = unfoldLines cs
|
|
|
|
ms = values "exposed-modules: " ls
|
|
|
|
|
|
|
|
values :: String -> [String] -> [String]
|
|
|
|
values tag ls = value
|
|
|
|
where
|
|
|
|
value = map (drop len) fs
|
|
|
|
len = length tag
|
|
|
|
fs = filter (tag `isPrefixOf`) ls
|
|
|
|
|
|
|
|
----------------------------------------------------------------
|
|
|
|
|
|
|
|
unfoldLines :: String -> [String]
|
|
|
|
unfoldLines xs = self xs
|
|
|
|
where
|
|
|
|
splitNL = break (== '\n')
|
|
|
|
self "" = []
|
|
|
|
self s = let (l, s') = splitNL s
|
|
|
|
in case s' of
|
|
|
|
[] -> [l]
|
|
|
|
(_:' ':s'') -> cont s'' l
|
|
|
|
(_:s'') -> l : self s''
|
|
|
|
cont s a = let (l, s') = splitNL $ dropWhile (== ' ') s
|
|
|
|
a' = a ++ " " ++ l
|
|
|
|
in case s' of
|
|
|
|
[] -> [a']
|
|
|
|
(_:' ':s'') -> cont s'' a'
|
|
|
|
(_:s'') -> a' : self s''
|