{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, RecordWildCards, ScopedTypeVariables #-}
module Input.Cabal(
PkgName, Package(..),
parseCabalTarball, readGhcPkg,
packagePopularity, readCabal
) where
import Input.Settings
import Data.List.Extra
import System.FilePath
import Control.DeepSeq
import Control.Exception
import Control.Exception.Extra
import Control.Monad
import System.IO.Extra
import General.Str
import System.Exit
import qualified System.Process.ByteString as BS
import qualified Data.ByteString.UTF8 as UTF8
import System.Directory
import Data.Char
import Data.Maybe
import Data.Tuple.Extra
import qualified Data.Map.Strict as Map
import General.Util
import General.Conduit
import Data.Semigroup
import Control.Applicative
import Prelude
data Package = Package
{Package -> [(Str, Str)]
packageTags :: ![(Str, Str)]
,Package -> Bool
packageLibrary :: !Bool
,Package -> Str
packageSynopsis :: !Str
,Package -> Str
packageVersion :: !Str
,Package -> [Str]
packageDepends :: ![PkgName]
,Package -> Maybe FilePath
packageDocs :: !(Maybe FilePath)
} deriving Int -> Package -> ShowS
[Package] -> ShowS
Package -> FilePath
(Int -> Package -> ShowS)
-> (Package -> FilePath) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> FilePath
$cshow :: Package -> FilePath
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show
instance Semigroup Package where
Package x1 :: [(Str, Str)]
x1 x2 :: Bool
x2 x3 :: Str
x3 x4 :: Str
x4 x5 :: [Str]
x5 x6 :: Maybe FilePath
x6 <> :: Package -> Package -> Package
<> Package y1 :: [(Str, Str)]
y1 y2 :: Bool
y2 y3 :: Str
y3 y4 :: Str
y4 y5 :: [Str]
y5 y6 :: Maybe FilePath
y6 =
[(Str, Str)]
-> Bool -> Str -> Str -> [Str] -> Maybe FilePath -> Package
Package ([(Str, Str)]
x1[(Str, Str)] -> [(Str, Str)] -> [(Str, Str)]
forall a. [a] -> [a] -> [a]
++[(Str, Str)]
y1) (Bool
x2Bool -> Bool -> Bool
||Bool
y2) (Str -> Str -> Str
one Str
x3 Str
y3) (Str -> Str -> Str
one Str
x4 Str
y4) ([Str] -> [Str]
forall a. Ord a => [a] -> [a]
nubOrd ([Str] -> [Str]) -> [Str] -> [Str]
forall a b. (a -> b) -> a -> b
$ [Str]
x5 [Str] -> [Str] -> [Str]
forall a. [a] -> [a] -> [a]
++ [Str]
y5) (Maybe FilePath
x6 Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe FilePath
y6)
where one :: Str -> Str -> Str
one a :: Str
a b :: Str
b = if Str -> Bool
strNull Str
a then Str
b else Str
a
instance Monoid Package where
mempty :: Package
mempty = [(Str, Str)]
-> Bool -> Str -> Str -> [Str] -> Maybe FilePath -> Package
Package [] Bool
True Str
forall a. Monoid a => a
mempty Str
forall a. Monoid a => a
mempty [] Maybe FilePath
forall a. Maybe a
Nothing
mappend :: Package -> Package -> Package
mappend = Package -> Package -> Package
forall a. Semigroup a => a -> a -> a
(<>)
instance NFData Package where
rnf :: Package -> ()
rnf (Package a :: [(Str, Str)]
a b :: Bool
b c :: Str
c d :: Str
d e :: [Str]
e f :: Maybe FilePath
f) = ([(Str, Str)], Bool, Str, Str, [Str], Maybe FilePath) -> ()
forall a. NFData a => a -> ()
rnf ([(Str, Str)]
a,Bool
b,Str
c,Str
d,[Str]
e,Maybe FilePath
f)
packagePopularity :: Map.Map PkgName Package -> ([String], Map.Map PkgName Int)
packagePopularity :: Map Str Package -> ([FilePath], Map Str Int)
packagePopularity cbl :: Map Str Package
cbl = Map Str Int
mp Map Str Int
-> ([FilePath], Map Str Int) -> ([FilePath], Map Str Int)
forall a b. a -> b -> b
`seq` ([FilePath]
errs, Map Str Int
mp)
where
mp :: Map Str Int
mp = ([Str] -> Int) -> Map Str [Str] -> Map Str Int
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [Str] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map Str [Str]
good
errs :: [FilePath]
errs = [ Str -> FilePath
strUnpack Str
user FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ".cabal: Import of non-existant package " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Str -> FilePath
strUnpack Str
name FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
(if [Str] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Str]
rest then "" else ", also imported by " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show ([Str] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Str]
rest) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ " others")
| (name :: Str
name, user :: Str
user:rest :: [Str]
rest) <- Map Str [Str] -> [(Str, [Str])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Str [Str]
bad]
(good :: Map Str [Str]
good, bad :: Map Str [Str]
bad) = (Str -> [Str] -> Bool)
-> Map Str [Str] -> (Map Str [Str], Map Str [Str])
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\k :: Str
k _ -> Str
k Str -> Map Str Package -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Str Package
cbl) (Map Str [Str] -> (Map Str [Str], Map Str [Str]))
-> Map Str [Str] -> (Map Str [Str], Map Str [Str])
forall a b. (a -> b) -> a -> b
$
([Str] -> [Str] -> [Str]) -> [(Str, [Str])] -> Map Str [Str]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Str] -> [Str] -> [Str]
forall a. [a] -> [a] -> [a]
(++) [(Str
b,[Str
a]) | (a :: Str
a,bs :: Package
bs) <- Map Str Package -> [(Str, Package)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Str Package
cbl, Str
b <- Package -> [Str]
packageDepends Package
bs]
readGhcPkg :: Settings -> IO (Map.Map PkgName Package)
readGhcPkg :: Settings -> IO (Map Str Package)
readGhcPkg settings :: Settings
settings = do
Maybe FilePath
topdir <- FilePath -> IO (Maybe FilePath)
findExecutable "ghc-pkg"
(exit :: ExitCode
exit, stdout :: ByteString
stdout, stderr :: ByteString
stderr) <- FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
BS.readProcessWithExitCode "ghc-pkg" ["dump"] ByteString
forall a. Monoid a => a
mempty
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
exit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
forall a. Partial => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error when reading from ghc-pkg, " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exit FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
UTF8.toString ByteString
stderr
let g :: ShowS
g (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "$topdir" -> Just x :: FilePath
x) | Just t :: FilePath
t <- Maybe FilePath
topdir = ShowS
takeDirectory FilePath
t FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
x
g x :: FilePath
x = FilePath
x
let fixer :: Package -> Package
fixer p :: Package
p = Package
p{packageLibrary :: Bool
packageLibrary = Bool
True, packageDocs :: Maybe FilePath
packageDocs = ShowS
g ShowS -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Maybe FilePath
packageDocs Package
p}
let f :: [FilePath] -> Maybe (Str, Package)
f ((FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "name: " -> Just x :: FilePath
x):xs :: [FilePath]
xs) = (Str, Package) -> Maybe (Str, Package)
forall a. a -> Maybe a
Just (FilePath -> Str
strPack FilePath
x, Package -> Package
fixer (Package -> Package) -> Package -> Package
forall a b. (a -> b) -> a -> b
$ Settings -> FilePath -> Package
readCabal Settings
settings (FilePath -> Package) -> FilePath -> Package
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
xs)
f xs :: [FilePath]
xs = Maybe (Str, Package)
forall a. Maybe a
Nothing
Map Str Package -> IO (Map Str Package)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Str Package -> IO (Map Str Package))
-> Map Str Package -> IO (Map Str Package)
forall a b. (a -> b) -> a -> b
$ [(Str, Package)] -> Map Str Package
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Str, Package)] -> Map Str Package)
-> [(Str, Package)] -> Map Str Package
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> Maybe (Str, Package))
-> [[FilePath]] -> [(Str, Package)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [FilePath] -> Maybe (Str, Package)
f ([[FilePath]] -> [(Str, Package)])
-> [[FilePath]] -> [(Str, Package)]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [[FilePath]]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn ["---"] ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\r') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
UTF8.toString ByteString
stdout
parseCabalTarball :: Settings -> FilePath -> IO (Map.Map PkgName Package)
parseCabalTarball :: Settings -> FilePath -> IO (Map Str Package)
parseCabalTarball settings :: Settings
settings tarfile :: FilePath
tarfile = do
[(Str, Package)]
res <- ConduitT () Void IO [(Str, Package)] -> IO [(Str, Package)]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO [(Str, Package)] -> IO [(Str, Package)])
-> ConduitT () Void IO [(Str, Package)] -> IO [(Str, Package)]
forall a b. (a -> b) -> a -> b
$
([(FilePath, ByteString)]
-> ConduitT () (FilePath, ByteString) IO ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList ([(FilePath, ByteString)]
-> ConduitT () (FilePath, ByteString) IO ())
-> ConduitT () (FilePath, ByteString) IO [(FilePath, ByteString)]
-> ConduitT () (FilePath, ByteString) IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [(FilePath, ByteString)]
-> ConduitT () (FilePath, ByteString) IO [(FilePath, ByteString)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [(FilePath, ByteString)]
tarballReadFiles FilePath
tarfile)) ConduitT () (FilePath, ByteString) IO ()
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
-> ConduitT () Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
((FilePath, ByteString) -> (FilePath, ByteString))
-> ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (ShowS -> (FilePath, ByteString) -> (FilePath, ByteString)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ShowS
takeBaseName) ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((FilePath, ByteString) -> FilePath)
-> ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
forall (m :: * -> *) b a.
(Monad m, Eq b) =>
(a -> b) -> ConduitM a a m ()
groupOnLastC (FilePath, ByteString) -> FilePath
forall a b. (a, b) -> a
fst ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((FilePath, ByteString) -> IO (FilePath, ByteString))
-> ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC ((FilePath, ByteString) -> IO (FilePath, ByteString)
forall a. a -> IO a
evaluate ((FilePath, ByteString) -> IO (FilePath, ByteString))
-> ((FilePath, ByteString) -> (FilePath, ByteString))
-> (FilePath, ByteString)
-> IO (FilePath, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, ByteString) -> (FilePath, ByteString)
forall a. NFData a => a -> a
force) ConduitT (FilePath, ByteString) (FilePath, ByteString) IO ()
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
Int
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
forall o r. Int -> ConduitM o Void IO r -> ConduitM o Void IO r
pipelineC 10 (((FilePath, ByteString) -> (Str, Package))
-> ConduitT (FilePath, ByteString) (Str, Package) IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (FilePath -> Str
strPack (FilePath -> Str)
-> (ByteString -> Package)
-> (FilePath, ByteString)
-> (Str, Package)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** Settings -> FilePath -> Package
readCabal Settings
settings (FilePath -> Package)
-> (ByteString -> FilePath) -> ByteString -> Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
lbstrUnpack) ConduitT (FilePath, ByteString) (Str, Package) IO ()
-> ConduitM (Str, Package) Void IO [(Str, Package)]
-> ConduitM (FilePath, ByteString) Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((Str, Package) -> IO (Str, Package))
-> ConduitT (Str, Package) (Str, Package) IO ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC ((Str, Package) -> IO (Str, Package)
forall a. a -> IO a
evaluate ((Str, Package) -> IO (Str, Package))
-> ((Str, Package) -> (Str, Package))
-> (Str, Package)
-> IO (Str, Package)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Str, Package) -> (Str, Package)
forall a. NFData a => a -> a
force) ConduitT (Str, Package) (Str, Package) IO ()
-> ConduitM (Str, Package) Void IO [(Str, Package)]
-> ConduitM (Str, Package) Void IO [(Str, Package)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Str, Package) Void IO [(Str, Package)]
forall (m :: * -> *) a o. Monad m => ConduitM a o m [a]
sinkList)
Map Str Package -> IO (Map Str Package)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Str Package -> IO (Map Str Package))
-> Map Str Package -> IO (Map Str Package)
forall a b. (a -> b) -> a -> b
$ [(Str, Package)] -> Map Str Package
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Str, Package)]
res
readCabal :: Settings -> String -> Package
readCabal :: Settings -> FilePath -> Package
readCabal Settings{..} src :: FilePath
src = $WPackage :: [(Str, Str)]
-> Bool -> Str -> Str -> [Str] -> Maybe FilePath -> Package
Package{..}
where
mp :: Map FilePath [FilePath]
mp = ([FilePath] -> [FilePath] -> [FilePath])
-> [(FilePath, [FilePath])] -> Map FilePath [FilePath]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
(++) ([(FilePath, [FilePath])] -> Map FilePath [FilePath])
-> [(FilePath, [FilePath])] -> Map FilePath [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [(FilePath, [FilePath])]
lexCabal FilePath
src
ask :: FilePath -> [FilePath]
ask x :: FilePath
x = [FilePath] -> FilePath -> Map FilePath [FilePath] -> [FilePath]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] FilePath
x Map FilePath [FilePath]
mp
packageDepends :: [Str]
packageDepends =
(FilePath -> Str) -> [FilePath] -> [Str]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Str
strPack ([FilePath] -> [Str]) -> [FilePath] -> [Str]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "-" ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlpha (FilePath -> Bool) -> ShowS -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take 1) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
splitOn "-" (FilePath -> [FilePath]) -> ShowS -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
word1) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
(FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> FilePath -> [FilePath]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',')) (FilePath -> [FilePath]
ask "build-depends") [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
words (FilePath -> [FilePath]
ask "depends")
packageVersion :: Str
packageVersion = FilePath -> Str
strPack (FilePath -> Str) -> FilePath -> Str
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> [FilePath]
ask "version") [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["0.0"]
packageSynopsis :: Str
packageSynopsis = FilePath -> Str
strPack (FilePath -> Str) -> FilePath -> Str
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
ask "synopsis"
packageLibrary :: Bool
packageLibrary = "library" FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
lower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) (FilePath -> [FilePath]
lines FilePath
src)
packageDocs :: Maybe FilePath
packageDocs = [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
ask "haddock-html"
packageTags :: [(Str, Str)]
packageTags = ((FilePath, FilePath) -> (Str, Str))
-> [(FilePath, FilePath)] -> [(Str, Str)]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Str) -> (FilePath, FilePath) -> (Str, Str)
forall a b. (a -> b) -> (a, a) -> (b, b)
both FilePath -> Str
strPack) ([(FilePath, FilePath)] -> [(Str, Str)])
-> [(FilePath, FilePath)] -> [(Str, Str)]
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. Ord a => [a] -> [a]
nubOrd ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
xs,) ([FilePath] -> [(FilePath, FilePath)])
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
cleanup ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
ask [FilePath]
xs
| [FilePath]
xs <- [["license"],["category"],["author","maintainer"]]]
cleanup :: FilePath -> [FilePath]
cleanup =
(FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= "") ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
renameTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate "-" ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ('@' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> ShowS -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` "<(")) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
unwords ([[FilePath]] -> [FilePath])
-> (FilePath -> [[FilePath]]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [[FilePath]]
forall a. (a -> Bool) -> [a] -> [[a]]
split (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "and") ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> [FilePath]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ",&")
lexCabal :: String -> [(String, [String])]
lexCabal :: FilePath -> [(FilePath, [FilePath])]
lexCabal = [FilePath] -> [(FilePath, [FilePath])]
f ([FilePath] -> [(FilePath, [FilePath])])
-> (FilePath -> [FilePath]) -> FilePath -> [(FilePath, [FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
where
f :: [FilePath] -> [(FilePath, [FilePath])]
f (x :: FilePath
x:xs :: [FilePath]
xs) | (white :: FilePath
white,x :: FilePath
x) <- (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace FilePath
x
, (name :: FilePath
name@(_:_),x :: FilePath
x) <- (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\c :: Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-') FilePath
x
, ':':x :: FilePath
x <- ShowS
trim FilePath
x
, (xs1 :: [FilePath]
xs1,xs2 :: [FilePath]
xs2) <- (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\s :: FilePath
s -> FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace FilePath
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
white) [FilePath]
xs
= (ShowS
lower FilePath
name, ShowS
trim FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [FilePath] -> [FilePath]
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace ["."] [""] (ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS
trim ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> (FilePath, FilePath)
forall a. Eq a => [a] -> [a] -> ([a], [a])
breakOn "--") [FilePath]
xs1)) (FilePath, [FilePath])
-> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. a -> [a] -> [a]
: [FilePath] -> [(FilePath, [FilePath])]
f [FilePath]
xs2
f (x :: FilePath
x:xs :: [FilePath]
xs) = [FilePath] -> [(FilePath, [FilePath])]
f [FilePath]
xs
f [] = []