{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, UndecidableInstances #-}
module Debian.Control.Common
    ( -- * Types
      Control'(..)
    , Paragraph'(..)
    , Field'(..)
    , ControlFunctions(..)
    , mergeControls
    , fieldValue
    , removeField
    , prependFields
    , appendFields
    , renameField
    , modifyField
    , raiseFields
    , parseControlFromCmd
    , md5sumField
    , protectFieldText'
    )
    where

import Control.Monad (msum)
import Data.Char (isSpace)
import Data.List as List (dropWhileEnd, partition, intersperse)
import Data.ListLike as LL (ListLike, cons, dropWhileEnd, empty, find, null, singleton)
import Data.ListLike.String as LL (StringLike, lines, unlines)
import Data.Monoid ((<>))
import Debian.Pretty (PP(..))
import System.Exit (ExitCode(ExitSuccess, ExitFailure))
import System.IO (Handle)
import System.Process (runInteractiveCommand, waitForProcess)
import Text.ParserCombinators.Parsec (ParseError)
import Text.PrettyPrint (Doc, text, hcat)
import Distribution.Pretty (Pretty(pretty))

newtype Control' a
    = Control { forall a. Control' a -> [Paragraph' a]
unControl :: [Paragraph' a] } deriving (Control' a -> Control' a -> Bool
forall a. Eq a => Control' a -> Control' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control' a -> Control' a -> Bool
$c/= :: forall a. Eq a => Control' a -> Control' a -> Bool
== :: Control' a -> Control' a -> Bool
$c== :: forall a. Eq a => Control' a -> Control' a -> Bool
Eq, Control' a -> Control' a -> Bool
Control' a -> Control' a -> Ordering
Control' a -> Control' a -> Control' a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Control' a)
forall a. Ord a => Control' a -> Control' a -> Bool
forall a. Ord a => Control' a -> Control' a -> Ordering
forall a. Ord a => Control' a -> Control' a -> Control' a
min :: Control' a -> Control' a -> Control' a
$cmin :: forall a. Ord a => Control' a -> Control' a -> Control' a
max :: Control' a -> Control' a -> Control' a
$cmax :: forall a. Ord a => Control' a -> Control' a -> Control' a
>= :: Control' a -> Control' a -> Bool
$c>= :: forall a. Ord a => Control' a -> Control' a -> Bool
> :: Control' a -> Control' a -> Bool
$c> :: forall a. Ord a => Control' a -> Control' a -> Bool
<= :: Control' a -> Control' a -> Bool
$c<= :: forall a. Ord a => Control' a -> Control' a -> Bool
< :: Control' a -> Control' a -> Bool
$c< :: forall a. Ord a => Control' a -> Control' a -> Bool
compare :: Control' a -> Control' a -> Ordering
$ccompare :: forall a. Ord a => Control' a -> Control' a -> Ordering
Ord, ReadPrec [Control' a]
ReadPrec (Control' a)
ReadS [Control' a]
forall a. Read a => ReadPrec [Control' a]
forall a. Read a => ReadPrec (Control' a)
forall a. Read a => Int -> ReadS (Control' a)
forall a. Read a => ReadS [Control' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Control' a]
$creadListPrec :: forall a. Read a => ReadPrec [Control' a]
readPrec :: ReadPrec (Control' a)
$creadPrec :: forall a. Read a => ReadPrec (Control' a)
readList :: ReadS [Control' a]
$creadList :: forall a. Read a => ReadS [Control' a]
readsPrec :: Int -> ReadS (Control' a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Control' a)
Read, Int -> Control' a -> ShowS
forall a. Show a => Int -> Control' a -> ShowS
forall a. Show a => [Control' a] -> ShowS
forall a. Show a => Control' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control' a] -> ShowS
$cshowList :: forall a. Show a => [Control' a] -> ShowS
show :: Control' a -> String
$cshow :: forall a. Show a => Control' a -> String
showsPrec :: Int -> Control' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Control' a -> ShowS
Show)

newtype Paragraph' a
    = Paragraph [Field' a]
    deriving (Paragraph' a -> Paragraph' a -> Bool
forall a. Eq a => Paragraph' a -> Paragraph' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paragraph' a -> Paragraph' a -> Bool
$c/= :: forall a. Eq a => Paragraph' a -> Paragraph' a -> Bool
== :: Paragraph' a -> Paragraph' a -> Bool
$c== :: forall a. Eq a => Paragraph' a -> Paragraph' a -> Bool
Eq, Paragraph' a -> Paragraph' a -> Bool
Paragraph' a -> Paragraph' a -> Ordering
Paragraph' a -> Paragraph' a -> Paragraph' a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Paragraph' a)
forall a. Ord a => Paragraph' a -> Paragraph' a -> Bool
forall a. Ord a => Paragraph' a -> Paragraph' a -> Ordering
forall a. Ord a => Paragraph' a -> Paragraph' a -> Paragraph' a
min :: Paragraph' a -> Paragraph' a -> Paragraph' a
$cmin :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Paragraph' a
max :: Paragraph' a -> Paragraph' a -> Paragraph' a
$cmax :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Paragraph' a
>= :: Paragraph' a -> Paragraph' a -> Bool
$c>= :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Bool
> :: Paragraph' a -> Paragraph' a -> Bool
$c> :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Bool
<= :: Paragraph' a -> Paragraph' a -> Bool
$c<= :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Bool
< :: Paragraph' a -> Paragraph' a -> Bool
$c< :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Bool
compare :: Paragraph' a -> Paragraph' a -> Ordering
$ccompare :: forall a. Ord a => Paragraph' a -> Paragraph' a -> Ordering
Ord, ReadPrec [Paragraph' a]
ReadPrec (Paragraph' a)
ReadS [Paragraph' a]
forall a. Read a => ReadPrec [Paragraph' a]
forall a. Read a => ReadPrec (Paragraph' a)
forall a. Read a => Int -> ReadS (Paragraph' a)
forall a. Read a => ReadS [Paragraph' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Paragraph' a]
$creadListPrec :: forall a. Read a => ReadPrec [Paragraph' a]
readPrec :: ReadPrec (Paragraph' a)
$creadPrec :: forall a. Read a => ReadPrec (Paragraph' a)
readList :: ReadS [Paragraph' a]
$creadList :: forall a. Read a => ReadS [Paragraph' a]
readsPrec :: Int -> ReadS (Paragraph' a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Paragraph' a)
Read, Int -> Paragraph' a -> ShowS
forall a. Show a => Int -> Paragraph' a -> ShowS
forall a. Show a => [Paragraph' a] -> ShowS
forall a. Show a => Paragraph' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Paragraph' a] -> ShowS
$cshowList :: forall a. Show a => [Paragraph' a] -> ShowS
show :: Paragraph' a -> String
$cshow :: forall a. Show a => Paragraph' a -> String
showsPrec :: Int -> Paragraph' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Paragraph' a -> ShowS
Show)

-- |NOTE: we do not strip the leading or trailing whitespace in the
-- name or value
data Field' a
    = Field (a, a)
    | Comment a     -- ^ Lines beginning with #
      deriving (Field' a -> Field' a -> Bool
forall a. Eq a => Field' a -> Field' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field' a -> Field' a -> Bool
$c/= :: forall a. Eq a => Field' a -> Field' a -> Bool
== :: Field' a -> Field' a -> Bool
$c== :: forall a. Eq a => Field' a -> Field' a -> Bool
Eq, Field' a -> Field' a -> Bool
Field' a -> Field' a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Field' a)
forall a. Ord a => Field' a -> Field' a -> Bool
forall a. Ord a => Field' a -> Field' a -> Ordering
forall a. Ord a => Field' a -> Field' a -> Field' a
min :: Field' a -> Field' a -> Field' a
$cmin :: forall a. Ord a => Field' a -> Field' a -> Field' a
max :: Field' a -> Field' a -> Field' a
$cmax :: forall a. Ord a => Field' a -> Field' a -> Field' a
>= :: Field' a -> Field' a -> Bool
$c>= :: forall a. Ord a => Field' a -> Field' a -> Bool
> :: Field' a -> Field' a -> Bool
$c> :: forall a. Ord a => Field' a -> Field' a -> Bool
<= :: Field' a -> Field' a -> Bool
$c<= :: forall a. Ord a => Field' a -> Field' a -> Bool
< :: Field' a -> Field' a -> Bool
$c< :: forall a. Ord a => Field' a -> Field' a -> Bool
compare :: Field' a -> Field' a -> Ordering
$ccompare :: forall a. Ord a => Field' a -> Field' a -> Ordering
Ord, ReadPrec [Field' a]
ReadPrec (Field' a)
ReadS [Field' a]
forall a. Read a => ReadPrec [Field' a]
forall a. Read a => ReadPrec (Field' a)
forall a. Read a => Int -> ReadS (Field' a)
forall a. Read a => ReadS [Field' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Field' a]
$creadListPrec :: forall a. Read a => ReadPrec [Field' a]
readPrec :: ReadPrec (Field' a)
$creadPrec :: forall a. Read a => ReadPrec (Field' a)
readList :: ReadS [Field' a]
$creadList :: forall a. Read a => ReadS [Field' a]
readsPrec :: Int -> ReadS (Field' a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Field' a)
Read, Int -> Field' a -> ShowS
forall a. Show a => Int -> Field' a -> ShowS
forall a. Show a => [Field' a] -> ShowS
forall a. Show a => Field' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field' a] -> ShowS
$cshowList :: forall a. Show a => [Field' a] -> ShowS
show :: Field' a -> String
$cshow :: forall a. Show a => Field' a -> String
showsPrec :: Int -> Field' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Field' a -> ShowS
Show)

class ControlFunctions a where
    -- |'parseControlFromFile' @filepath@ is a simple wrapper function
    -- that parses @filepath@ using 'pControl'
    parseControlFromFile :: FilePath -> IO (Either ParseError (Control' a))
    -- |'parseControlFromHandle' @sourceName@ @handle@ - @sourceName@ is only used for error reporting
    parseControlFromHandle :: String -> Handle -> IO (Either ParseError (Control' a))
    -- |'parseControlFromString' @sourceName@ @text@ - @sourceName@ is only used for error reporting
    parseControl :: String -> a -> (Either ParseError (Control' a))
    -- | 'lookupP' @fieldName paragraph@ looks up a 'Field' in a 'Paragraph'.
    -- @N.B.@ trailing and leading whitespace is /not/ stripped.
    lookupP :: String -> (Paragraph' a) -> Maybe (Field' a)
    -- |Strip the trailing and leading space and tab characters from a
    -- string. Folded whitespace is /not/ unfolded. This should probably
    -- be moved to someplace more general purpose.
    stripWS :: a -> a
    -- |Protect field value text so the parser doesn't split it into
    -- multiple fields or paragraphs.  This must modify all field text
    -- to enforce two conditions: (1) All lines other than the initial
    -- one must begin with a space or a tab, and (2) the trailing
    -- white space must not contain newlines.  This is called before
    -- pretty printing to prevent the parser from misinterpreting
    -- field text as multiple fields or paragraphs.
    protectFieldText :: a -> a
    asString :: a -> String

-- | This can usually be used as the implementation of protectFieldText
protectFieldText' :: forall a. (StringLike a, ListLike a Char) => ControlFunctions a => a -> a
protectFieldText' :: forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText' a
s =
    let trimmedLines :: [a]
        trimmedLines :: [a]
trimmedLines = forall a b. (a -> b) -> [a] -> [b]
map (forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhileEnd Char -> Bool
isSpace :: a -> a) forall a b. (a -> b) -> a -> b
$ (forall s full. (StringLike s, ListLike full s) => s -> full
LL.lines a
s :: [a])
        strippedLines :: [a]
        strippedLines :: [a]
strippedLines = forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd forall full item. ListLike full item => full -> Bool
LL.null [a]
trimmedLines in
    -- Split the text into lines, drop trailing whitespace from each
    -- line, and drop trailing blank lines.
    case [a]
strippedLines of
      [] -> forall full item. ListLike full item => full
empty
      (a
l : [a]
ls) ->
          let -- The first line is indented one space
              l' :: a
l' = {-LL.cons ' '-} a
l
              -- Null lines are replaced by a single '.'  If any line
              -- is unindented, all will get an additional space of
              -- indentation.
              ls' :: [a]
ls' = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {full}. ListLike full Char => full -> Bool
indented [a]
ls of
                      Bool
True -> forall a b. (a -> b) -> [a] -> [b]
map (\ a
x -> if forall full item. ListLike full item => full -> Bool
LL.null a
x then (forall full item. ListLike full item => item -> full -> full
LL.cons Char
' ' forall a b. (a -> b) -> a -> b
$ forall full item. ListLike full item => item -> full
singleton Char
'.') else a
x) [a]
ls
                      Bool
False -> forall a b. (a -> b) -> [a] -> [b]
map (forall full item. ListLike full item => item -> full -> full
LL.cons Char
' ') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ a
x -> if forall full item. ListLike full item => full -> Bool
LL.null a
x then (forall full item. ListLike full item => item -> full
singleton Char
'.') else a
x) [a]
ls in
          forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhileEnd Char -> Bool
isSpace (forall s full. (StringLike s, ListLike full s) => full -> s
LL.unlines (a
l' forall a. a -> [a] -> [a]
: [a]
ls'))
    where
      indented :: full -> Bool
indented full
l = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isSpace (forall full item.
ListLike full item =>
(item -> Bool) -> full -> Maybe item
LL.find (forall a b. a -> b -> a
const Bool
True) full
l)

-- | This may have bad performance issues (dsf: Whoever wrote this
-- comment should have explained why.)
instance (ControlFunctions a, Pretty (PP a)) => Pretty (Control' a) where
    pretty :: Control' a -> Doc
pretty = forall a. (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc
ppControl
instance (ControlFunctions a, Pretty (PP a)) => Pretty (Paragraph' a) where
    pretty :: Paragraph' a -> Doc
pretty = forall a.
(ControlFunctions a, Pretty (PP a)) =>
Paragraph' a -> Doc
ppParagraph

instance (ControlFunctions a, Pretty (PP a)) => Pretty (Field' a) where
    pretty :: Field' a -> Doc
pretty = forall a. (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField

ppControl :: (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc
ppControl :: forall a. (ControlFunctions a, Pretty (PP a)) => Control' a -> Doc
ppControl (Control [Paragraph' a]
paragraph) =
    [Doc] -> Doc
hcat (forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
"\n") (forall a b. (a -> b) -> [a] -> [b]
map forall a.
(ControlFunctions a, Pretty (PP a)) =>
Paragraph' a -> Doc
ppParagraph [Paragraph' a]
paragraph))

ppParagraph :: (ControlFunctions a, Pretty (PP a)) => Paragraph' a -> Doc
ppParagraph :: forall a.
(ControlFunctions a, Pretty (PP a)) =>
Paragraph' a -> Doc
ppParagraph (Paragraph [Field' a]
fields) =
    [Doc] -> Doc
hcat (forall a b. (a -> b) -> [a] -> [b]
map (\ Field' a
x -> forall a. (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField Field' a
x forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\n") [Field' a]
fields)

ppField :: (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField :: forall a. (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField (Field (a
n,a
v)) = forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP a
n) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP (forall a. ControlFunctions a => a -> a
protectFieldText a
v))
ppField (Comment a
c) = forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP a
c)

mergeControls :: [Control' a] -> Control' a
mergeControls :: forall a. [Control' a] -> Control' a
mergeControls [Control' a]
controls =
    forall a. [Paragraph' a] -> Control' a
Control (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Control' a -> [Paragraph' a]
unControl [Control' a]
controls)

fieldValue :: (ControlFunctions a) => String -> Paragraph' a -> Maybe a
fieldValue :: forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
fieldName Paragraph' a
paragraph =
    case forall a.
ControlFunctions a =>
String -> Paragraph' a -> Maybe (Field' a)
lookupP String
fieldName Paragraph' a
paragraph of
      Just (Field (a
_, a
val)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ControlFunctions a => a -> a
stripWS a
val
      Maybe (Field' a)
_ -> forall a. Maybe a
Nothing

removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a
removeField :: forall a. Eq a => a -> Paragraph' a -> Paragraph' a
removeField a
toRemove (Paragraph [Field' a]
fields) =
    forall a. [Field' a] -> Paragraph' a
Paragraph (forall a. (a -> Bool) -> [a] -> [a]
filter Field' a -> Bool
remove [Field' a]
fields)
    where
      remove :: Field' a -> Bool
remove (Field (a
name,a
_)) = a
name forall a. Eq a => a -> a -> Bool
== a
toRemove
      remove (Comment a
_) = Bool
False

prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a
prependFields :: forall a. [Field' a] -> Paragraph' a -> Paragraph' a
prependFields [Field' a]
newfields (Paragraph [Field' a]
fields) = forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' a]
newfields forall a. [a] -> [a] -> [a]
++ [Field' a]
fields)

appendFields :: [Field' a] -> Paragraph' a -> Paragraph' a
appendFields :: forall a. [Field' a] -> Paragraph' a -> Paragraph' a
appendFields [Field' a]
newfields (Paragraph [Field' a]
fields) = forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' a]
fields forall a. [a] -> [a] -> [a]
++ [Field' a]
newfields)

renameField :: (Eq a) => a -> a -> Paragraph' a -> Paragraph' a
renameField :: forall a. Eq a => a -> a -> Paragraph' a -> Paragraph' a
renameField a
oldname a
newname (Paragraph [Field' a]
fields) =
    forall a. [Field' a] -> Paragraph' a
Paragraph (forall a b. (a -> b) -> [a] -> [b]
map Field' a -> Field' a
rename [Field' a]
fields)
    where
      rename :: Field' a -> Field' a
rename (Field (a
name, a
value)) | a
name forall a. Eq a => a -> a -> Bool
== a
oldname = forall a. (a, a) -> Field' a
Field (a
newname, a
value)
      rename Field' a
field = Field' a
field

modifyField :: (Eq a) => a -> (a -> a) -> Paragraph' a -> Paragraph' a
modifyField :: forall a. Eq a => a -> (a -> a) -> Paragraph' a -> Paragraph' a
modifyField a
name a -> a
f (Paragraph [Field' a]
fields) =
    forall a. [Field' a] -> Paragraph' a
Paragraph (forall a b. (a -> b) -> [a] -> [b]
map Field' a -> Field' a
modify [Field' a]
fields)
    where
      modify :: Field' a -> Field' a
modify (Field (a
name', a
value)) | a
name' forall a. Eq a => a -> a -> Bool
== a
name = forall a. (a, a) -> Field' a
Field (a
name, a -> a
f a
value)
      modify Field' a
field = Field' a
field

-- | Move selected fields to the beginning of a paragraph.
raiseFields :: (Eq a) => (a -> Bool) -> Paragraph' a -> Paragraph' a
raiseFields :: forall a. Eq a => (a -> Bool) -> Paragraph' a -> Paragraph' a
raiseFields a -> Bool
f (Paragraph [Field' a]
fields) =
    let ([Field' a]
a, [Field' a]
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Field' a -> Bool
f' [Field' a]
fields in forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' a]
a forall a. [a] -> [a] -> [a]
++ [Field' a]
b)
    where f' :: Field' a -> Bool
f' (Field (a
name, a
_)) = a -> Bool
f a
name
          f' (Comment a
_) = Bool
False

-- | Run a command and parse its output as a control file.
parseControlFromCmd :: ControlFunctions a => String -> IO (Either String (Control' a))
parseControlFromCmd :: forall a.
ControlFunctions a =>
String -> IO (Either String (Control' a))
parseControlFromCmd String
cmd =
    do
      (Handle
_, Handle
outh, Handle
_, ProcessHandle
handle) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
cmd
      Either ParseError (Control' a)
result <- forall a.
ControlFunctions a =>
String -> Handle -> IO (Either ParseError (Control' a))
parseControlFromHandle String
cmd Handle
outh
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall {b}. ProcessHandle -> b -> IO (Either String b)
finish ProcessHandle
handle) Either ParseError (Control' a)
result
    where
      finish :: ProcessHandle -> b -> IO (Either String b)
finish ProcessHandle
handle b
control =
          do
            ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
handle
            case ExitCode
exitCode of
              ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
control
              ExitFailure Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String
"Failure: " forall a. [a] -> [a] -> [a]
++ String
cmd forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)

-- |look up the md5sum file in a paragraph
-- Tries several different variations:
--  MD5Sum:
--  Md5Sum:
--  MD5sum:
md5sumField :: (ControlFunctions a) => Paragraph' a -> Maybe a
md5sumField :: forall a. ControlFunctions a => Paragraph' a -> Maybe a
md5sumField Paragraph' a
p = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5Sum" Paragraph' a
p, forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Md5Sum" Paragraph' a
p, forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5sum" Paragraph' a
p]