{-# 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 { Control' a -> [Paragraph' a]
unControl :: [Paragraph' a] } deriving (Control' a -> Control' a -> Bool
(Control' a -> Control' a -> Bool)
-> (Control' a -> Control' a -> Bool) -> Eq (Control' a)
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, Eq (Control' a)
Eq (Control' a)
-> (Control' a -> Control' a -> Ordering)
-> (Control' a -> Control' a -> Bool)
-> (Control' a -> Control' a -> Bool)
-> (Control' a -> Control' a -> Bool)
-> (Control' a -> Control' a -> Bool)
-> (Control' a -> Control' a -> Control' a)
-> (Control' a -> Control' a -> Control' a)
-> Ord (Control' a)
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
$cp1Ord :: forall a. Ord a => Eq (Control' a)
Ord, ReadPrec [Control' a]
ReadPrec (Control' a)
Int -> ReadS (Control' a)
ReadS [Control' a]
(Int -> ReadS (Control' a))
-> ReadS [Control' a]
-> ReadPrec (Control' a)
-> ReadPrec [Control' a]
-> Read (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
[Control' a] -> ShowS
Control' a -> String
(Int -> Control' a -> ShowS)
-> (Control' a -> String)
-> ([Control' a] -> ShowS)
-> Show (Control' a)
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
(Paragraph' a -> Paragraph' a -> Bool)
-> (Paragraph' a -> Paragraph' a -> Bool) -> Eq (Paragraph' a)
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, Eq (Paragraph' a)
Eq (Paragraph' a)
-> (Paragraph' a -> Paragraph' a -> Ordering)
-> (Paragraph' a -> Paragraph' a -> Bool)
-> (Paragraph' a -> Paragraph' a -> Bool)
-> (Paragraph' a -> Paragraph' a -> Bool)
-> (Paragraph' a -> Paragraph' a -> Bool)
-> (Paragraph' a -> Paragraph' a -> Paragraph' a)
-> (Paragraph' a -> Paragraph' a -> Paragraph' a)
-> Ord (Paragraph' a)
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
$cp1Ord :: forall a. Ord a => Eq (Paragraph' a)
Ord, ReadPrec [Paragraph' a]
ReadPrec (Paragraph' a)
Int -> ReadS (Paragraph' a)
ReadS [Paragraph' a]
(Int -> ReadS (Paragraph' a))
-> ReadS [Paragraph' a]
-> ReadPrec (Paragraph' a)
-> ReadPrec [Paragraph' a]
-> Read (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
[Paragraph' a] -> ShowS
Paragraph' a -> String
(Int -> Paragraph' a -> ShowS)
-> (Paragraph' a -> String)
-> ([Paragraph' a] -> ShowS)
-> Show (Paragraph' a)
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
(Field' a -> Field' a -> Bool)
-> (Field' a -> Field' a -> Bool) -> Eq (Field' a)
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, Eq (Field' a)
Eq (Field' a)
-> (Field' a -> Field' a -> Ordering)
-> (Field' a -> Field' a -> Bool)
-> (Field' a -> Field' a -> Bool)
-> (Field' a -> Field' a -> Bool)
-> (Field' a -> Field' a -> Bool)
-> (Field' a -> Field' a -> Field' a)
-> (Field' a -> Field' a -> Field' a)
-> Ord (Field' a)
Field' a -> Field' a -> Bool
Field' a -> Field' a -> Ordering
Field' a -> Field' a -> Field' 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 (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
$cp1Ord :: forall a. Ord a => Eq (Field' a)
Ord, ReadPrec [Field' a]
ReadPrec (Field' a)
Int -> ReadS (Field' a)
ReadS [Field' a]
(Int -> ReadS (Field' a))
-> ReadS [Field' a]
-> ReadPrec (Field' a)
-> ReadPrec [Field' a]
-> Read (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
[Field' a] -> ShowS
Field' a -> String
(Int -> Field' a -> ShowS)
-> (Field' a -> String) -> ([Field' a] -> ShowS) -> Show (Field' a)
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' :: a -> a
protectFieldText' a
s =
    let trimmedLines :: [a]
        trimmedLines :: [a]
trimmedLines = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> a -> a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhileEnd Char -> Bool
isSpace :: a -> a) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a]
forall s full. (StringLike s, ListLike full s) => s -> full
LL.lines a
s :: [a])
        strippedLines :: [a]
        strippedLines :: [a]
strippedLines = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd a -> Bool
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
      [] -> a
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 (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
forall full. ListLike full Char => full -> Bool
indented [a]
ls of
                      Bool
True -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
x -> if a -> Bool
forall full item. ListLike full item => full -> Bool
LL.null a
x then (Char -> a -> a
forall full item. ListLike full item => item -> full -> full
LL.cons Char
' ' (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Char -> a
forall full item. ListLike full item => item -> full
singleton Char
'.') else a
x) [a]
ls
                      Bool
False -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> a -> a
forall full item. ListLike full item => item -> full -> full
LL.cons Char
' ') ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\ a
x -> if a -> Bool
forall full item. ListLike full item => full -> Bool
LL.null a
x then (Char -> a
forall full item. ListLike full item => item -> full
singleton Char
'.') else a
x) [a]
ls in
          (Char -> Bool) -> a -> a
forall full item.
ListLike full item =>
(item -> Bool) -> full -> full
LL.dropWhileEnd Char -> Bool
isSpace ([a] -> a
forall s full. (StringLike s, ListLike full s) => full -> s
LL.unlines (a
l' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls'))
    where
      indented :: full -> Bool
indented full
l = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Char -> Bool
isSpace ((Char -> Bool) -> full -> Maybe Char
forall full item.
ListLike full item =>
(item -> Bool) -> full -> Maybe item
LL.find (Bool -> Char -> Bool
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 = Control' a -> Doc
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 = Paragraph' a -> Doc
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 = Field' a -> Doc
forall a. (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField

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

ppParagraph :: (ControlFunctions a, Pretty (PP a)) => Paragraph' a -> Doc
ppParagraph :: Paragraph' a -> Doc
ppParagraph (Paragraph [Field' a]
fields) =
    [Doc] -> Doc
hcat ((Field' a -> Doc) -> [Field' a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ Field' a
x -> Field' a -> Doc
forall a. (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField Field' a
x Doc -> Doc -> Doc
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 :: Field' a -> Doc
ppField (Field (a
n,a
v)) = PP a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> PP a
forall a. a -> PP a
PP a
n) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> PP a
forall a. a -> PP a
PP (a -> a
forall a. ControlFunctions a => a -> a
protectFieldText a
v))
ppField (Comment a
c) = PP a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> PP a
forall a. a -> PP a
PP a
c)

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

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

removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a
removeField :: a -> Paragraph' a -> Paragraph' a
removeField a
toRemove (Paragraph [Field' a]
fields) =
    [Field' a] -> Paragraph' a
forall a. [Field' a] -> Paragraph' a
Paragraph ((Field' a -> Bool) -> [Field' a] -> [Field' a]
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
toRemove
      remove (Comment a
_) = Bool
False

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

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

renameField :: (Eq a) => a -> a -> Paragraph' a -> Paragraph' a
renameField :: a -> a -> Paragraph' a -> Paragraph' a
renameField a
oldname a
newname (Paragraph [Field' a]
fields) =
    [Field' a] -> Paragraph' a
forall a. [Field' a] -> Paragraph' a
Paragraph ((Field' a -> Field' a) -> [Field' a] -> [Field' a]
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
oldname = (a, a) -> Field' a
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 :: a -> (a -> a) -> Paragraph' a -> Paragraph' a
modifyField a
name a -> a
f (Paragraph [Field' a]
fields) =
    [Field' a] -> Paragraph' a
forall a. [Field' a] -> Paragraph' a
Paragraph ((Field' a -> Field' a) -> [Field' a] -> [Field' a]
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' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name = (a, a) -> Field' a
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 :: (a -> Bool) -> Paragraph' a -> Paragraph' a
raiseFields a -> Bool
f (Paragraph [Field' a]
fields) =
    let ([Field' a]
a, [Field' a]
b) = (Field' a -> Bool) -> [Field' a] -> ([Field' a], [Field' a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Field' a -> Bool
f' [Field' a]
fields in [Field' a] -> Paragraph' a
forall a. [Field' a] -> Paragraph' a
Paragraph ([Field' a]
a [Field' a] -> [Field' a] -> [Field' 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 :: 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 <- String -> Handle -> IO (Either ParseError (Control' a))
forall a.
ControlFunctions a =>
String -> Handle -> IO (Either ParseError (Control' a))
parseControlFromHandle String
cmd Handle
outh
      (ParseError -> IO (Either String (Control' a)))
-> (Control' a -> IO (Either String (Control' a)))
-> Either ParseError (Control' a)
-> IO (Either String (Control' a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either String (Control' a) -> IO (Either String (Control' a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Control' a) -> IO (Either String (Control' a)))
-> (ParseError -> Either String (Control' a))
-> ParseError
-> IO (Either String (Control' a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Control' a)
forall a b. a -> Either a b
Left (String -> Either String (Control' a))
-> (ParseError -> String)
-> ParseError
-> Either String (Control' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) (ProcessHandle -> Control' a -> IO (Either String (Control' a))
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 -> Either String b -> IO (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ b -> Either String b
forall a b. b -> Either a b
Right b
control
              ExitFailure Int
n -> Either String b -> IO (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left (String
"Failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
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 :: Paragraph' a -> Maybe a
md5sumField Paragraph' a
p = [Maybe a] -> Maybe a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5Sum" Paragraph' a
p, String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"Md5Sum" Paragraph' a
p, String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue String
"MD5sum" Paragraph' a
p]