{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Stack.PackageDump
    ( Line
    , eachSection
    , eachPair
    , DumpPackage (..)
    , conduitDumpPackage
    , ghcPkgDump
    , ghcPkgDescribe
    , sinkMatching
    , pruneDeps
    ) where

import           Stack.Prelude
import           Data.Attoparsec.Args
import           Data.Attoparsec.Text as P
import           Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified RIO.Text as T
import qualified Distribution.Text as C
import           Path.Extra (toFilePathNoTrailingSep)
import           Stack.GhcPkg
import           Stack.Types.Config (HasCompiler (..), GhcPkgExe (..), DumpPackage (..))
import           Stack.Types.GhcPkgId
import           RIO.Process hiding (readProcess)

-- | Call ghc-pkg dump with appropriate flags and stream to the given @Sink@, for a single database
ghcPkgDump
    :: (HasProcessContext env, HasLogFunc env)
    => GhcPkgExe
    -> [Path Abs Dir] -- ^ if empty, use global
    -> ConduitM Text Void (RIO env) a
    -> RIO env a
ghcPkgDump :: GhcPkgExe
-> [Path Abs Dir] -> ConduitM Text Void (RIO env) a -> RIO env a
ghcPkgDump GhcPkgExe
pkgexe = GhcPkgExe
-> [String]
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
forall env a.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe
-> [String]
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
ghcPkgCmdArgs GhcPkgExe
pkgexe [String
"dump"]

-- | Call ghc-pkg describe with appropriate flags and stream to the given @Sink@, for a single database
ghcPkgDescribe
    :: (HasProcessContext env, HasLogFunc env, HasCompiler env)
    => GhcPkgExe
    -> PackageName
    -> [Path Abs Dir] -- ^ if empty, use global
    -> ConduitM Text Void (RIO env) a
    -> RIO env a
ghcPkgDescribe :: GhcPkgExe
-> PackageName
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
ghcPkgDescribe GhcPkgExe
pkgexe PackageName
pkgName' = GhcPkgExe
-> [String]
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
forall env a.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe
-> [String]
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
ghcPkgCmdArgs GhcPkgExe
pkgexe [String
"describe", String
"--simple-output", PackageName -> String
packageNameString PackageName
pkgName']

-- | Call ghc-pkg and stream to the given @Sink@, for a single database
ghcPkgCmdArgs
    :: (HasProcessContext env, HasLogFunc env)
    => GhcPkgExe
    -> [String]
    -> [Path Abs Dir] -- ^ if empty, use global
    -> ConduitM Text Void (RIO env) a
    -> RIO env a
ghcPkgCmdArgs :: GhcPkgExe
-> [String]
-> [Path Abs Dir]
-> ConduitM Text Void (RIO env) a
-> RIO env a
ghcPkgCmdArgs pkgexe :: GhcPkgExe
pkgexe@(GhcPkgExe Path Abs File
pkgPath) [String]
cmd [Path Abs Dir]
mpkgDbs ConduitM Text Void (RIO env) a
sink = do
    case [Path Abs Dir] -> [Path Abs Dir]
forall a. [a] -> [a]
reverse [Path Abs Dir]
mpkgDbs of
        (Path Abs Dir
pkgDb:[Path Abs Dir]
_) -> GhcPkgExe -> Path Abs Dir -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env) =>
GhcPkgExe -> Path Abs Dir -> RIO env ()
createDatabase GhcPkgExe
pkgexe Path Abs Dir
pkgDb -- TODO maybe use some retry logic instead?
        [Path Abs Dir]
_ -> () -> RIO env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    String
-> [String] -> ConduitM ByteString Void (RIO env) a -> RIO env a
forall env a.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String
-> [String] -> ConduitM ByteString Void (RIO env) a -> RIO env a
sinkProcessStdout (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
pkgPath) [String]
args ConduitM ByteString Void (RIO env) a
sink'
  where
    args :: [String]
args = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case [Path Abs Dir]
mpkgDbs of
              [] -> [String
"--global", String
"--no-user-package-db"]
              [Path Abs Dir]
_ -> [String
"--user", String
"--no-user-package-db"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  (Path Abs Dir -> [String]) -> [Path Abs Dir] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Path Abs Dir
pkgDb -> [String
"--package-db", Path Abs Dir -> String
forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
pkgDb]) [Path Abs Dir]
mpkgDbs
        , [String]
cmd
        , [String
"--expand-pkgroot"]
        ]
    sink' :: ConduitM ByteString Void (RIO env) a
sink' = ConduitT ByteString Text (RIO env) ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
CT.decodeUtf8 ConduitT ByteString Text (RIO env) ()
-> ConduitM Text Void (RIO env) a
-> ConduitM ByteString Void (RIO env) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text Void (RIO env) a
sink

-- | Prune a list of possible packages down to those whose dependencies are met.
--
-- * id uniquely identifies an item
--
-- * There can be multiple items per name
pruneDeps
    :: (Ord name, Ord id)
    => (id -> name) -- ^ extract the name from an id
    -> (item -> id) -- ^ the id of an item
    -> (item -> [id]) -- ^ get the dependencies of an item
    -> (item -> item -> item) -- ^ choose the desired of two possible items
    -> [item] -- ^ input items
    -> Map name item
pruneDeps :: (id -> name)
-> (item -> id)
-> (item -> [id])
-> (item -> item -> item)
-> [item]
-> Map name item
pruneDeps id -> name
getName item -> id
getId item -> [id]
getDepends item -> item -> item
chooseBest =
      [(name, item)] -> Map name item
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(name, item)] -> Map name item)
-> ([item] -> [(name, item)]) -> [item] -> Map name item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (item -> (name, item)) -> [item] -> [(name, item)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (id -> name
getName (id -> name) -> (item -> id) -> item -> name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. item -> id
getId (item -> name) -> (item -> item) -> item -> (name, item)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& item -> item
forall a. a -> a
id)
    ([item] -> [(name, item)])
-> ([item] -> [item]) -> [item] -> [(name, item)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set id -> Set name -> [item] -> [item] -> [item]
loop Set id
forall a. Set a
Set.empty Set name
forall a. Set a
Set.empty []
  where
    loop :: Set id -> Set name -> [item] -> [item] -> [item]
loop Set id
foundIds Set name
usedNames [item]
foundItems [item]
dps =
        case [Either (name, item) (Maybe item)]
-> ([(name, item)], [Maybe item])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (name, item) (Maybe item)]
 -> ([(name, item)], [Maybe item]))
-> [Either (name, item) (Maybe item)]
-> ([(name, item)], [Maybe item])
forall a b. (a -> b) -> a -> b
$ (item -> Either (name, item) (Maybe item))
-> [item] -> [Either (name, item) (Maybe item)]
forall a b. (a -> b) -> [a] -> [b]
map item -> Either (name, item) (Maybe item)
depsMet [item]
dps of
            ([], [Maybe item]
_) -> [item]
foundItems
            ([(name, item)]
s', [Maybe item]
dps') ->
                let foundIds' :: Map name item
foundIds' = (item -> item -> item) -> [(name, item)] -> Map name item
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith item -> item -> item
chooseBest [(name, item)]
s'
                    foundIds'' :: Set id
foundIds'' = [id] -> Set id
forall a. Ord a => [a] -> Set a
Set.fromList ([id] -> Set id) -> [id] -> Set id
forall a b. (a -> b) -> a -> b
$ (item -> id) -> [item] -> [id]
forall a b. (a -> b) -> [a] -> [b]
map item -> id
getId ([item] -> [id]) -> [item] -> [id]
forall a b. (a -> b) -> a -> b
$ Map name item -> [item]
forall k a. Map k a -> [a]
Map.elems Map name item
foundIds'
                    usedNames' :: Set name
usedNames' = Map name item -> Set name
forall k a. Map k a -> Set k
Map.keysSet Map name item
foundIds'
                    foundItems' :: [item]
foundItems' = Map name item -> [item]
forall k a. Map k a -> [a]
Map.elems Map name item
foundIds'
                 in Set id -> Set name -> [item] -> [item] -> [item]
loop
                        (Set id -> Set id -> Set id
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set id
foundIds Set id
foundIds'')
                        (Set name -> Set name -> Set name
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set name
usedNames Set name
usedNames')
                        ([item]
foundItems [item] -> [item] -> [item]
forall a. [a] -> [a] -> [a]
++ [item]
foundItems')
                        ([Maybe item] -> [item]
forall a. [Maybe a] -> [a]
catMaybes [Maybe item]
dps')
      where
        depsMet :: item -> Either (name, item) (Maybe item)
depsMet item
dp
            | name
name name -> Set name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set name
usedNames = Maybe item -> Either (name, item) (Maybe item)
forall a b. b -> Either a b
Right Maybe item
forall a. Maybe a
Nothing
            | (id -> Bool) -> [id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (id -> Set id -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set id
foundIds) (item -> [id]
getDepends item
dp) = (name, item) -> Either (name, item) (Maybe item)
forall a b. a -> Either a b
Left (name
name, item
dp)
            | Bool
otherwise = Maybe item -> Either (name, item) (Maybe item)
forall a b. b -> Either a b
Right (Maybe item -> Either (name, item) (Maybe item))
-> Maybe item -> Either (name, item) (Maybe item)
forall a b. (a -> b) -> a -> b
$ item -> Maybe item
forall a. a -> Maybe a
Just item
dp
          where
            id' :: id
id' = item -> id
getId item
dp
            name :: name
name = id -> name
getName id
id'

-- | Find the package IDs matching the given constraints with all dependencies installed.
-- Packages not mentioned in the provided @Map@ are allowed to be present too.
sinkMatching :: Monad m
             => Map PackageName Version -- ^ allowed versions
             -> ConduitM DumpPackage o m (Map PackageName DumpPackage)
sinkMatching :: Map PackageName Version
-> ConduitM DumpPackage o m (Map PackageName DumpPackage)
sinkMatching Map PackageName Version
allowed =
      [(PackageName, DumpPackage)] -> Map PackageName DumpPackage
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(PackageName, DumpPackage)] -> Map PackageName DumpPackage)
-> ([DumpPackage] -> [(PackageName, DumpPackage)])
-> [DumpPackage]
-> Map PackageName DumpPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DumpPackage -> (PackageName, DumpPackage))
-> [DumpPackage] -> [(PackageName, DumpPackage)]
forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (DumpPackage -> PackageIdentifier) -> DumpPackage -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpPackage -> PackageIdentifier
dpPackageIdent (DumpPackage -> PackageName)
-> (DumpPackage -> DumpPackage)
-> DumpPackage
-> (PackageName, DumpPackage)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& DumpPackage -> DumpPackage
forall a. a -> a
id)
    ([DumpPackage] -> [(PackageName, DumpPackage)])
-> ([DumpPackage] -> [DumpPackage])
-> [DumpPackage]
-> [(PackageName, DumpPackage)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map GhcPkgId DumpPackage -> [DumpPackage]
forall k a. Map k a -> [a]
Map.elems
    (Map GhcPkgId DumpPackage -> [DumpPackage])
-> ([DumpPackage] -> Map GhcPkgId DumpPackage)
-> [DumpPackage]
-> [DumpPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcPkgId -> GhcPkgId)
-> (DumpPackage -> GhcPkgId)
-> (DumpPackage -> [GhcPkgId])
-> (DumpPackage -> DumpPackage -> DumpPackage)
-> [DumpPackage]
-> Map GhcPkgId DumpPackage
forall name id item.
(Ord name, Ord id) =>
(id -> name)
-> (item -> id)
-> (item -> [id])
-> (item -> item -> item)
-> [item]
-> Map name item
pruneDeps
        GhcPkgId -> GhcPkgId
forall a. a -> a
id
        DumpPackage -> GhcPkgId
dpGhcPkgId
        DumpPackage -> [GhcPkgId]
dpDepends
        DumpPackage -> DumpPackage -> DumpPackage
forall a b. a -> b -> a
const -- Could consider a better comparison in the future
    ([DumpPackage] -> Map PackageName DumpPackage)
-> ConduitT DumpPackage o m [DumpPackage]
-> ConduitM DumpPackage o m (Map PackageName DumpPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((DumpPackage -> Bool) -> ConduitT DumpPackage DumpPackage m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter (PackageIdentifier -> Bool
isAllowed (PackageIdentifier -> Bool)
-> (DumpPackage -> PackageIdentifier) -> DumpPackage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumpPackage -> PackageIdentifier
dpPackageIdent) ConduitT DumpPackage DumpPackage m ()
-> ConduitT DumpPackage o m [DumpPackage]
-> ConduitT DumpPackage o m [DumpPackage]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT DumpPackage o m [DumpPackage]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume)
  where
    isAllowed :: PackageIdentifier -> Bool
isAllowed (PackageIdentifier PackageName
name Version
version) =
        case PackageName -> Map PackageName Version -> Maybe Version
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name Map PackageName Version
allowed of
            Just Version
version' | Version
version Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
version' -> Bool
False
            Maybe Version
_ -> Bool
True

data PackageDumpException
    = MissingSingleField Text (Map Text [Line])
    | Couldn'tParseField Text [Line]
    deriving Typeable
instance Exception PackageDumpException
instance Show PackageDumpException where
    show :: PackageDumpException -> String
show (MissingSingleField Text
name Map Text [Text]
values) = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Expected single value for field name "
        , Text -> String
forall a. Show a => a -> String
show Text
name
        , String
" when parsing ghc-pkg dump output:"
        ]) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((Text, [Text]) -> String) -> [(Text, [Text])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, [Text]
v) -> String
"    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text, [Text]) -> String
forall a. Show a => a -> String
show (Text
k, [Text]
v)) (Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text [Text]
values)
    show (Couldn'tParseField Text
name [Text]
ls) =
        String
"Couldn't parse the field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from lines: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
ls

-- | Convert a stream of bytes into a stream of @DumpPackage@s
conduitDumpPackage :: MonadThrow m
                   => ConduitM Text DumpPackage m ()
conduitDumpPackage :: ConduitM Text DumpPackage m ()
conduitDumpPackage = (ConduitM Text (Maybe DumpPackage) m ()
-> ConduitM (Maybe DumpPackage) DumpPackage m ()
-> ConduitM Text DumpPackage m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Maybe DumpPackage) DumpPackage m ()
forall (m :: * -> *) a. Monad m => ConduitT (Maybe a) a m ()
CL.catMaybes) (ConduitM Text (Maybe DumpPackage) m ()
 -> ConduitM Text DumpPackage m ())
-> ConduitM Text (Maybe DumpPackage) m ()
-> ConduitM Text DumpPackage m ()
forall a b. (a -> b) -> a -> b
$ ConduitM Text Void m (Maybe DumpPackage)
-> ConduitM Text (Maybe DumpPackage) m ()
forall (m :: * -> *) a.
Monad m =>
ConduitM Text Void m a -> ConduitM Text a m ()
eachSection (ConduitM Text Void m (Maybe DumpPackage)
 -> ConduitM Text (Maybe DumpPackage) m ())
-> ConduitM Text Void m (Maybe DumpPackage)
-> ConduitM Text (Maybe DumpPackage) m ()
forall a b. (a -> b) -> a -> b
$ do
    [(Text, [Text])]
pairs <- (Text -> ConduitM Text Void m (Text, [Text]))
-> ConduitM Text (Text, [Text]) m ()
forall (m :: * -> *) a.
Monad m =>
(Text -> ConduitM Text Void m a) -> ConduitM Text a m ()
eachPair (\Text
k -> (Text
k, ) ([Text] -> (Text, [Text]))
-> ConduitT Text Void m [Text]
-> ConduitM Text Void m (Text, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Text Void m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume) ConduitM Text (Text, [Text]) m ()
-> ConduitM (Text, [Text]) Void m [(Text, [Text])]
-> ConduitM Text Void m [(Text, [Text])]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Text, [Text]) Void m [(Text, [Text])]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
    let m :: Map Text [Text]
m = [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, [Text])]
pairs
    let parseS :: Text -> m Text
parseS Text
k =
            case Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text [Text]
m of
                Just [Text
v] -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
v
                Maybe [Text]
_ -> PackageDumpException -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PackageDumpException -> m Text) -> PackageDumpException -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [Text] -> PackageDumpException
MissingSingleField Text
k Map Text [Text]
m
        -- Can't fail: if not found, same as an empty list. See:
        -- https://github.com/fpco/stack/issues/182
        parseM :: Text -> [Text]
parseM Text
k = [Text] -> Text -> Map Text [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Text
k Map Text [Text]
m

        parseDepend :: MonadThrow m => Text -> m (Maybe GhcPkgId)
        parseDepend :: Text -> m (Maybe GhcPkgId)
parseDepend Text
"builtin_rts" = Maybe GhcPkgId -> m (Maybe GhcPkgId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GhcPkgId
forall a. Maybe a
Nothing
        parseDepend Text
bs =
            (GhcPkgId -> Maybe GhcPkgId) -> m GhcPkgId -> m (Maybe GhcPkgId)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GhcPkgId -> Maybe GhcPkgId
forall a. a -> Maybe a
Just (m GhcPkgId -> m (Maybe GhcPkgId))
-> m GhcPkgId -> m (Maybe GhcPkgId)
forall a b. (a -> b) -> a -> b
$ Text -> m GhcPkgId
forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId Text
bs'
          where
            (Text
bs', Bool
_builtinRts) =
                case Text -> Text -> Maybe Text
stripSuffixText Text
" builtin_rts" Text
bs of
                    Maybe Text
Nothing ->
                        case Text -> Text -> Maybe Text
stripPrefixText Text
"builtin_rts " Text
bs of
                            Maybe Text
Nothing -> (Text
bs, Bool
False)
                            Just Text
x -> (Text
x, Bool
True)
                    Just Text
x -> (Text
x, Bool
True)
    case Text -> Map Text [Text] -> Maybe [Text]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"id" Map Text [Text]
m of
        Just [Text
"builtin_rts"] -> Maybe DumpPackage -> ConduitM Text Void m (Maybe DumpPackage)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DumpPackage
forall a. Maybe a
Nothing
        Maybe [Text]
_ -> do
            PackageName
name <- Text -> ConduitT Text Void m Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
parseS Text
"name" ConduitT Text Void m Text
-> (Text -> ConduitT Text Void m PackageName)
-> ConduitT Text Void m PackageName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ConduitT Text Void m PackageName
forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing (String -> ConduitT Text Void m PackageName)
-> (Text -> String) -> Text -> ConduitT Text Void m PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
            Version
version <- Text -> ConduitT Text Void m Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
parseS Text
"version" ConduitT Text Void m Text
-> (Text -> ConduitT Text Void m Version)
-> ConduitT Text Void m Version
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ConduitT Text Void m Version
forall (m :: * -> *). MonadThrow m => String -> m Version
parseVersionThrowing (String -> ConduitT Text Void m Version)
-> (Text -> String) -> Text -> ConduitT Text Void m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
            GhcPkgId
ghcPkgId <- Text -> ConduitT Text Void m Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
parseS Text
"id" ConduitT Text Void m Text
-> (Text -> ConduitT Text Void m GhcPkgId)
-> ConduitT Text Void m GhcPkgId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitT Text Void m GhcPkgId
forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId

            -- if a package has no modules, these won't exist
            let libDirKey :: Text
libDirKey = Text
"library-dirs"
                libraries :: [Text]
libraries = Text -> [Text]
parseM Text
"hs-libraries"
                exposedModules :: [Text]
exposedModules = Text -> [Text]
parseM Text
"exposed-modules"
                exposed :: [Text]
exposed = Text -> [Text]
parseM Text
"exposed"
                license :: Maybe License
license =
                    case Text -> [Text]
parseM Text
"license" of
                        [Text
licenseText] -> String -> Maybe License
forall a. Parsec a => String -> Maybe a
C.simpleParse (Text -> String
T.unpack Text
licenseText)
                        [Text]
_ -> Maybe License
forall a. Maybe a
Nothing
            [GhcPkgId]
depends <- (Text -> ConduitT Text Void m (Maybe GhcPkgId))
-> [Text] -> ConduitT Text Void m [GhcPkgId]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Text -> ConduitT Text Void m (Maybe GhcPkgId)
forall (m :: * -> *). MonadThrow m => Text -> m (Maybe GhcPkgId)
parseDepend ([Text] -> ConduitT Text Void m [GhcPkgId])
-> [Text] -> ConduitT Text Void m [GhcPkgId]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
T.words ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
parseM Text
"depends"

            -- Handle sublibs by recording the name of the parent library
            -- If name of parent library is missing, this is not a sublib.
            let mkParentLib :: PackageName -> PackageIdentifier
mkParentLib PackageName
n = PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
n Version
version
                parentLib :: Maybe PackageIdentifier
parentLib = PackageName -> PackageIdentifier
mkParentLib (PackageName -> PackageIdentifier)
-> Maybe PackageName -> Maybe PackageIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
forall (m :: * -> *). MonadThrow m => Text -> m Text
parseS Text
"package-name" Maybe Text -> (Text -> Maybe PackageName) -> Maybe PackageName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                             String -> Maybe PackageName
forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing (String -> Maybe PackageName)
-> (Text -> String) -> Text -> Maybe PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

            let parseQuoted :: Text -> m [String]
parseQuoted Text
key =
                    case (Text -> Either String [String])
-> [Text] -> Either String [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser [String] -> Text -> Either String [String]
forall a. Parser a -> Text -> Either String a
P.parseOnly (EscapingMode -> Parser [String]
argsParser EscapingMode
NoEscaping)) [Text]
val of
                        Left{} -> PackageDumpException -> m [String]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Text -> [Text] -> PackageDumpException
Couldn'tParseField Text
key [Text]
val)
                        Right [[String]]
dirs -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
dirs)
                  where
                    val :: [Text]
val = Text -> [Text]
parseM Text
key
            [String]
libDirPaths <- Text -> ConduitT Text Void m [String]
forall (m :: * -> *). MonadThrow m => Text -> m [String]
parseQuoted Text
libDirKey
            [String]
haddockInterfaces <- Text -> ConduitT Text Void m [String]
forall (m :: * -> *). MonadThrow m => Text -> m [String]
parseQuoted Text
"haddock-interfaces"
            [String]
haddockHtml <- Text -> ConduitT Text Void m [String]
forall (m :: * -> *). MonadThrow m => Text -> m [String]
parseQuoted Text
"haddock-html"

            Maybe DumpPackage -> ConduitM Text Void m (Maybe DumpPackage)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DumpPackage -> ConduitM Text Void m (Maybe DumpPackage))
-> Maybe DumpPackage -> ConduitM Text Void m (Maybe DumpPackage)
forall a b. (a -> b) -> a -> b
$ DumpPackage -> Maybe DumpPackage
forall a. a -> Maybe a
Just DumpPackage :: GhcPkgId
-> PackageIdentifier
-> Maybe PackageIdentifier
-> Maybe License
-> [String]
-> [Text]
-> Bool
-> Set ModuleName
-> [GhcPkgId]
-> [String]
-> Maybe String
-> Bool
-> DumpPackage
DumpPackage
                { dpGhcPkgId :: GhcPkgId
dpGhcPkgId = GhcPkgId
ghcPkgId
                , dpPackageIdent :: PackageIdentifier
dpPackageIdent = PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
name Version
version
                , dpParentLibIdent :: Maybe PackageIdentifier
dpParentLibIdent = Maybe PackageIdentifier
parentLib
                , dpLicense :: Maybe License
dpLicense = Maybe License
license
                , dpLibDirs :: [String]
dpLibDirs = [String]
libDirPaths
                , dpLibraries :: [Text]
dpLibraries = Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
libraries
                , dpHasExposedModules :: Bool
dpHasExposedModules = Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
libraries Bool -> Bool -> Bool
|| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
exposedModules)

                -- Strip trailing commas from ghc package exposed-modules (looks buggy to me...).
                -- Then try to parse the module names.
                , dpExposedModules :: Set ModuleName
dpExposedModules =
                      [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList
                    ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe ModuleName) -> [Text] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe ModuleName
forall a. Parsec a => String -> Maybe a
C.simpleParse (String -> Maybe ModuleName)
-> (Text -> String) -> Text -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.dropSuffix Text
",")
                    ([Text] -> [ModuleName]) -> [Text] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words
                    (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
exposedModules

                , dpDepends :: [GhcPkgId]
dpDepends = [GhcPkgId]
depends
                , dpHaddockInterfaces :: [String]
dpHaddockInterfaces = [String]
haddockInterfaces
                , dpHaddockHtml :: Maybe String
dpHaddockHtml = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
haddockHtml
                , dpIsExposed :: Bool
dpIsExposed = [Text]
exposed [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"True"]
                }

stripPrefixText :: Text -> Text -> Maybe Text
stripPrefixText :: Text -> Text -> Maybe Text
stripPrefixText Text
x Text
y
    | Text
x Text -> Text -> Bool
`T.isPrefixOf` Text
y = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
x) Text
y
    | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

stripSuffixText :: Text -> Text -> Maybe Text
stripSuffixText :: Text -> Text -> Maybe Text
stripSuffixText Text
x Text
y
    | Text
x Text -> Text -> Bool
`T.isSuffixOf` Text
y = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Text -> Int
T.length Text
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
x) Text
y
    | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

-- | A single line of input, not including line endings
type Line = Text

-- | Apply the given Sink to each section of output, broken by a single line containing ---
eachSection :: Monad m
            => ConduitM Line Void m a
            -> ConduitM Text a m ()
eachSection :: ConduitM Text Void m a -> ConduitM Text a m ()
eachSection ConduitM Text Void m a
inner =
    (Text -> Text) -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')) ConduitT Text Text m ()
-> ConduitM Text a m () -> ConduitM Text a m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
CT.lines ConduitT Text Text m ()
-> ConduitM Text a m () -> ConduitM Text a m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text a m ()
start
  where

    peekText :: ConduitT Text o m (Maybe Text)
peekText = ConduitT Text o m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Text o m (Maybe Text)
-> (Maybe Text -> ConduitT Text o m (Maybe Text))
-> ConduitT Text o m (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text o m (Maybe Text)
-> (Text -> ConduitT Text o m (Maybe Text))
-> Maybe Text
-> ConduitT Text o m (Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Text -> ConduitT Text o m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing) (\Text
bs ->
        if Text -> Bool
T.null Text
bs
            then ConduitT Text o m (Maybe Text)
peekText
            else Text -> ConduitT Text o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
bs ConduitT Text o m ()
-> ConduitT Text o m (Maybe Text) -> ConduitT Text o m (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Text -> ConduitT Text o m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bs))

    start :: ConduitM Text a m ()
start = ConduitT Text a m (Maybe Text)
forall o. ConduitT Text o m (Maybe Text)
peekText ConduitT Text a m (Maybe Text)
-> (Maybe Text -> ConduitM Text a m ()) -> ConduitM Text a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM Text a m ()
-> (Text -> ConduitM Text a m ())
-> Maybe Text
-> ConduitM Text a m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM Text a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ConduitM Text a m () -> Text -> ConduitM Text a m ()
forall a b. a -> b -> a
const ConduitM Text a m ()
go)

    go :: ConduitM Text a m ()
go = do
        a
x <- ConduitM Text Void m a -> Consumer Text m a
forall (m :: * -> *) a b. Monad m => Sink a m b -> Consumer a m b
toConsumer (ConduitM Text Void m a -> Consumer Text m a)
-> ConduitM Text Void m a -> Consumer Text m a
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> ConduitT Text Text m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
takeWhileC (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"---") ConduitT Text Text m ()
-> ConduitM Text Void m a -> ConduitM Text Void m a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text Void m a
inner
        a -> ConduitM Text a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
        Int -> ConduitM Text a m ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
CL.drop Int
1
        ConduitM Text a m ()
start

-- | Grab each key/value pair
eachPair :: Monad m
         => (Text -> ConduitM Line Void m a)
         -> ConduitM Line a m ()
eachPair :: (Text -> ConduitM Text Void m a) -> ConduitM Text a m ()
eachPair Text -> ConduitM Text Void m a
inner =
    ConduitM Text a m ()
start
  where
    start :: ConduitM Text a m ()
start = ConduitT Text a m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Text a m (Maybe Text)
-> (Maybe Text -> ConduitM Text a m ()) -> ConduitM Text a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM Text a m ()
-> (Text -> ConduitM Text a m ())
-> Maybe Text
-> ConduitM Text a m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM Text a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitM Text a m ()
start'

    start' :: Text -> ConduitM Text a m ()
start' Text
bs1 =
        ConduitM Text Void m a -> Consumer Text m a
forall (m :: * -> *) a b. Monad m => Sink a m b -> Consumer a m b
toConsumer (ConduitT Text Text m ()
valSrc ConduitT Text Text m ()
-> ConduitM Text Void m a -> ConduitM Text Void m a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text Void m a
inner Text
key) ConduitT Text a m a
-> (a -> ConduitM Text a m ()) -> ConduitM Text a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ConduitM Text a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitM Text a m ()
-> ConduitM Text a m () -> ConduitM Text a m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM Text a m ()
start
      where
        (Text
key, Text
bs2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
bs1
        (Text
spaces, Text
bs3) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
bs2
        indent :: Int
indent = Text -> Int
T.length Text
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
spaces

        valSrc :: ConduitT Text Text m ()
valSrc
            | Text -> Bool
T.null Text
bs3 = ConduitT Text Text m ()
noIndent
            | Bool
otherwise = Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
bs3 ConduitT Text Text m ()
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT Text Text m ()
forall (m :: * -> *). Monad m => Int -> ConduitT Text Text m ()
loopIndent Int
indent

    noIndent :: ConduitT Text Text m ()
noIndent = do
        Maybe Text
mx <- ConduitT Text Text m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
        case Maybe Text
mx of
            Maybe Text
Nothing -> () -> ConduitT Text Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Text
bs -> do
                let (Text
spaces, Text
val) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
bs
                if Text -> Int
T.length Text
spaces Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    then Text -> ConduitT Text Text m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
val
                    else do
                        Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
val
                        Int -> ConduitT Text Text m ()
forall (m :: * -> *). Monad m => Int -> ConduitT Text Text m ()
loopIndent (Text -> Int
T.length Text
spaces)

    loopIndent :: Int -> ConduitT Text Text m ()
loopIndent Int
i =
        ConduitT Text Text m ()
loop
      where
        loop :: ConduitT Text Text m ()
loop = ConduitT Text Text m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT Text Text m (Maybe Text)
-> (Maybe Text -> ConduitT Text Text m ())
-> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text Text m ()
-> (Text -> ConduitT Text Text m ())
-> Maybe Text
-> ConduitT Text Text m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT Text Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text Text m ()
go

        go :: Text -> ConduitT Text Text m ()
go Text
bs
            | Text -> Int
T.length Text
spaces Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
spaces =
                Text -> ConduitT Text Text m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
val ConduitT Text Text m ()
-> ConduitT Text Text m () -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Text Text m ()
loop
            | Bool
otherwise = Text -> ConduitT Text Text m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
bs
          where
            (Text
spaces, Text
val) = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
bs

-- | General purpose utility
takeWhileC :: Monad m => (a -> Bool) -> ConduitM a a m ()
takeWhileC :: (a -> Bool) -> ConduitM a a m ()
takeWhileC a -> Bool
f =
    ConduitM a a m ()
loop
  where
    loop :: ConduitM a a m ()
loop = ConduitT a a m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a a m (Maybe a)
-> (Maybe a -> ConduitM a a m ()) -> ConduitM a a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM a a m ()
-> (a -> ConduitM a a m ()) -> Maybe a -> ConduitM a a m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM a a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> ConduitM a a m ()
go

    go :: a -> ConduitM a a m ()
go a
x
        | a -> Bool
f a
x = a -> ConduitM a a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x ConduitM a a m () -> ConduitM a a m () -> ConduitM a a m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM a a m ()
loop
        | Bool
otherwise = a -> ConduitM a a m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover a
x