{-# LANGUAGE FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, UndecidableInstances #-}
module Debian.Control.Common
(
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)
data Field' a
= Field (a, a)
| a
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 -> IO (Either ParseError (Control' a))
parseControlFromHandle :: String -> Handle -> IO (Either ParseError (Control' a))
parseControl :: String -> a -> (Either ParseError (Control' a))
lookupP :: String -> (Paragraph' a) -> Maybe (Field' a)
stripWS :: a -> a
protectFieldText :: a -> a
asString :: a -> String
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
case [a]
strippedLines of
[] -> a
forall full item. ListLike full item => full
empty
(a
l : [a]
ls) ->
let
l' :: a
l' = a
l
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)
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
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
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)
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]