{-# 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' s :: 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
(l :: a
l : ls :: [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
True -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\ x :: 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 ' ' (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Char -> a
forall full item. ListLike full item => item -> full
singleton '.') else a
x) [a]
ls
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 ' ') ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\ x :: 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 '.') 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 l :: 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 :: [Paragraph' a]
paragraph) =
[Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text "\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 fields :: [Field' a]
fields) =
[Doc] -> Doc
hcat ((Field' a -> Doc) -> [Field' a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ x :: 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 "\n") [Field' a]
fields)
ppField :: (ControlFunctions a, Pretty (PP a)) => Field' a -> Doc
ppField :: Field' a -> Doc
ppField (Field (n :: a
n,v :: 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 ":" 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 c :: 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 controls :: [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 fieldName :: String
fieldName paragraph :: 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 (_, val :: 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 a
forall a. Maybe a
Nothing
removeField :: (Eq a) => a -> Paragraph' a -> Paragraph' a
removeField :: a -> Paragraph' a -> Paragraph' a
removeField toRemove :: a
toRemove (Paragraph fields :: [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 (name :: a
name,_)) = a
name a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
toRemove
remove (Comment _) = Bool
False
prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a
prependFields :: [Field' a] -> Paragraph' a -> Paragraph' a
prependFields newfields :: [Field' a]
newfields (Paragraph fields :: [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 newfields :: [Field' a]
newfields (Paragraph fields :: [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 oldname :: a
oldname newname :: a
newname (Paragraph fields :: [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 (name :: a
name, value :: 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 :: 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 name :: a
name f :: a -> a
f (Paragraph fields :: [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 (name' :: a
name', value :: 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 :: Field' a
field = Field' a
field
raiseFields :: (Eq a) => (a -> Bool) -> Paragraph' a -> Paragraph' a
raiseFields :: (a -> Bool) -> Paragraph' a -> Paragraph' a
raiseFields f :: a -> Bool
f (Paragraph fields :: [Field' a]
fields) =
let (a :: [Field' a]
a, b :: [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 (name :: a
name, _)) = a -> Bool
f a
name
f' (Comment _) = Bool
False
parseControlFromCmd :: ControlFunctions a => String -> IO (Either String (Control' a))
parseControlFromCmd :: String -> IO (Either String (Control' a))
parseControlFromCmd cmd :: String
cmd =
do
(_, outh :: 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 handle :: ProcessHandle
handle control :: b
control =
do
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
handle
case ExitCode
exitCode of
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 n :: 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 ("Failure: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " 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 p :: 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 "MD5Sum" Paragraph' a
p, String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue "Md5Sum" Paragraph' a
p, String -> Paragraph' a -> Maybe a
forall a. ControlFunctions a => String -> Paragraph' a -> Maybe a
fieldValue "MD5sum" Paragraph' a
p]