{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, RecordWildCards, ScopedTypeVariables #-}

-- | Module for reading Cabal files.
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 TYPE

-- | A representation of a Cabal package.
data Package = Package
    {Package -> [(Str, Str)]
packageTags :: ![(Str, Str)] -- ^ The Tag information, e.g. (category,Development) (author,Neil Mitchell).
    ,Package -> Bool
packageLibrary :: !Bool -- ^ True if the package provides a library (False if it is only an executable with no API)
    ,Package -> Str
packageSynopsis :: !Str -- ^ The synposis, grabbed from the top section.
    ,Package -> Str
packageVersion :: !Str -- ^ The version, grabbed from the top section.
    ,Package -> [Str]
packageDepends :: ![PkgName] -- ^ The list of packages that this package directly depends on.
    ,Package -> Maybe FilePath
packageDocs :: !(Maybe FilePath) -- ^ Directory where the documentation is located
    } 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 [(Str, Str)]
x1 Bool
x2 Str
x3 Str
x4 [Str]
x5 Maybe FilePath
x6 <> :: Package -> Package -> Package
<> Package [(Str, Str)]
y1 Bool
y2 Str
y3 Str
y4 [Str]
y5 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 Str
a 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 [(Str, Str)]
a Bool
b Str
c Str
d [Str]
e 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)


---------------------------------------------------------------------
-- POPULARITY

-- | Given a set of packages, return the popularity of each package, along with any warnings
--   about packages imported but not found.
packagePopularity :: Map.Map PkgName Package -> ([String], Map.Map PkgName Int)
packagePopularity :: Map Str Package -> ([FilePath], Map Str Int)
packagePopularity Map Str Package
cbl = Map Str Int
mp Map Str Int
-> ([FilePath], Map Str Int) -> ([FilePath], Map Str Int)
`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]
++ FilePath
".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 FilePath
"" else FilePath
", 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]
++ FilePath
" others")
                | (Str
name, Str
user:[Str]
rest) <- Map Str [Str] -> [(Str, [Str])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Str [Str]
bad]
        (Map Str [Str]
good, 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 (\Str
k [Str]
_ -> 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]) | (Str
a,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]


---------------------------------------------------------------------
-- READERS

-- | Run 'ghc-pkg' and get a list of packages which are installed.
readGhcPkg :: Settings -> IO (Map.Map PkgName Package)
readGhcPkg :: Settings -> IO (Map Str Package)
readGhcPkg Settings
settings = do
    Maybe FilePath
topdir <- FilePath -> IO (Maybe FilePath)
findExecutable FilePath
"ghc-pkg"
    -- important to use BS process reading so it's in Binary format, see #194
    (ExitCode
exit, ByteString
stdout, ByteString
stderr) <- FilePath
-> [FilePath]
-> ByteString
-> IO (ExitCode, ByteString, ByteString)
BS.readProcessWithExitCode FilePath
"ghc-pkg" [FilePath
"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
$ FilePath
"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]
++ FilePath
"\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 FilePath
"$topdir" -> Just FilePath
x) | Just FilePath
t <- Maybe FilePath
topdir = ShowS
takeDirectory FilePath
t FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
x
        g FilePath
x = FilePath
x
    let fixer :: Package -> Package
fixer 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 FilePath
"name: " -> Just FilePath
x):[FilePath]
xs) = (Str, Package) -> Maybe (Str, Package)
forall a. a -> Maybe a
Just (FilePath -> Str
strPack (FilePath -> Str) -> FilePath -> Str
forall a b. (a -> b) -> a -> b
$ ShowS
trimStart 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 [FilePath]
xs = Maybe (Str, Package)
forall a. Maybe a
Nothing
    Map Str Package -> IO (Map Str Package)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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] -> [[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
/= Char
'\r') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
UTF8.toString ByteString
stdout


-- | Given a tarball of Cabal files, parse the latest version of each package.
parseCabalTarball :: Settings -> FilePath -> IO (Map.Map PkgName Package)
-- items are stored as:
-- QuickCheck/2.7.5/QuickCheck.cabal
-- QuickCheck/2.7.6/QuickCheck.cabal
-- rely on the fact the highest version is last (using lastValues)
parseCabalTarball :: Settings -> FilePath -> IO (Map Str Package)
parseCabalTarball Settings
settings 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 Int
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 (f :: * -> *) a. Applicative f => a -> f a
pure (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


---------------------------------------------------------------------
-- PARSERS

-- | Cabal information, plus who I depend on
readCabal :: Settings -> String -> Package
readCabal :: Settings -> FilePath -> Package
readCabal Settings{ShowS
FilePath -> FilePath -> Int
reorderModule :: Settings -> FilePath -> FilePath -> Int
renameTag :: Settings -> ShowS
reorderModule :: FilePath -> FilePath -> Int
renameTag :: ShowS
..} FilePath
src = Package :: [(Str, Str)]
-> Bool -> Str -> Str -> [Str] -> Maybe FilePath -> Package
Package{Bool
[(Str, Str)]
[Str]
Maybe FilePath
Str
packageTags :: [(Str, Str)]
packageDocs :: Maybe FilePath
packageLibrary :: Bool
packageSynopsis :: Str
packageVersion :: Str
packageDepends :: [Str]
packageDocs :: Maybe FilePath
packageDepends :: [Str]
packageVersion :: Str
packageSynopsis :: Str
packageLibrary :: Bool
packageTags :: [(Str, Str)]
..}
    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 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] -> [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 -> [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 Int
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 -> [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
== Char
',')) (FilePath -> [FilePath]
ask FilePath
"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 FilePath
"depends")
        packageVersion :: Str
packageVersion = FilePath -> Str
strPack (FilePath -> Str) -> FilePath -> Str
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. a -> [a] -> a
headDef FilePath
"0.0" ([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 FilePath
"version")
        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 FilePath
"synopsis"
        packageLibrary :: Bool
packageLibrary = FilePath
"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 -> Bool) -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
ask FilePath
"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 <- [[FilePath
"license"],[FilePath
"category"],[FilePath
"author",FilePath
"maintainer"]]]

        -- split on things like "," "&" "and", then throw away email addresses, replace spaces with "-" and rename
        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 -> [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 -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
'@' 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 -> [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
== FilePath
"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` FilePath
",&")


-- Ignores nesting beacuse it's not interesting for any of the fields I care about
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 (FilePath
x:[FilePath]
xs) | (FilePath
white,FilePath
x) <- (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace FilePath
x
                 , (name :: FilePath
name@(Char
_:FilePath
_),FilePath
x) <- (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') FilePath
x
                 , Char
':':FilePath
x <- ShowS
trim FilePath
x
                 , ([FilePath]
xs1,[FilePath]
xs2) <- (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\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 [FilePath
"."] [FilePath
""] (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
"--") [FilePath]
xs1)) (FilePath, [FilePath])
-> [(FilePath, [FilePath])] -> [(FilePath, [FilePath])]
forall a. a -> [a] -> [a]
: [FilePath] -> [(FilePath, [FilePath])]
f [FilePath]
xs2
        f (FilePath
x:[FilePath]
xs) = [FilePath] -> [(FilePath, [FilePath])]
f [FilePath]
xs
        f [] = []