{-# 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 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)


---------------------------------------------------------------------
-- 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 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]


---------------------------------------------------------------------
-- 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
settings = do
    Maybe FilePath
topdir <- FilePath -> IO (Maybe FilePath)
findExecutable "ghc-pkg"
    -- important to use BS process reading so it's in Binary format, see #194
    (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 -> 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 xs :: [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]]
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


-- | 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
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 (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{..} 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] -> FilePath
forall a. a -> [a] -> a
headDef "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 "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 "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 -> 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 "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"]]]

        -- 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]
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` ",&")


-- 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 (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 [] = []