{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
module Debian.Control.String
(
Control'(..)
, Paragraph'(..)
, Field'(..)
, Control
, Paragraph
, Field
, ControlParser
, ControlFunctions(..)
, pControl
, mergeControls
, fieldValue
, removeField
, prependFields
, appendFields
, renameField
, modifyField
, raiseFields
) where
import qualified Control.Exception as E
import Data.Char (toLower)
import Data.List (find)
import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, protectFieldText, asString),
Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),
mergeControls, fieldValue, removeField, prependFields, appendFields,
renameField, modifyField, raiseFields, protectFieldText')
import System.IO (hGetContents)
import Text.ParserCombinators.Parsec (CharParser, parse, parseFromFile, sepEndBy, satisfy, oneOf, string, lookAhead, try, many, many1, (<|>), noneOf, char, eof)
type Field = Field' String
type Control = Control' String
type Paragraph = Paragraph' String
instance ControlFunctions String where
parseControlFromFile :: [Char] -> IO (Either ParseError (Control' [Char]))
parseControlFromFile [Char]
filepath =
Parser (Control' [Char])
-> [Char] -> IO (Either ParseError (Control' [Char]))
forall a. Parser a -> [Char] -> IO (Either ParseError a)
parseFromFile Parser (Control' [Char])
pControl [Char]
filepath
parseControlFromHandle :: [Char] -> Handle -> IO (Either ParseError (Control' [Char]))
parseControlFromHandle [Char]
sourceName Handle
handle =
IO [Char] -> IO (Either SomeException [Char])
forall e a. Exception e => IO a -> IO (Either e a)
E.try (Handle -> IO [Char]
hGetContents Handle
handle) IO (Either SomeException [Char])
-> (Either SomeException [Char]
-> IO (Either ParseError (Control' [Char])))
-> IO (Either ParseError (Control' [Char]))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(SomeException -> IO (Either ParseError (Control' [Char])))
-> ([Char] -> IO (Either ParseError (Control' [Char])))
-> Either SomeException [Char]
-> IO (Either ParseError (Control' [Char]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
e :: E.SomeException) -> [Char] -> IO (Either ParseError (Control' [Char]))
forall a. HasCallStack => [Char] -> a
error ([Char]
"parseControlFromHandle String: Failure parsing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
sourceName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)) (Either ParseError (Control' [Char])
-> IO (Either ParseError (Control' [Char]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Control' [Char])
-> IO (Either ParseError (Control' [Char])))
-> ([Char] -> Either ParseError (Control' [Char]))
-> [Char]
-> IO (Either ParseError (Control' [Char]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Either ParseError (Control' [Char])
forall a.
ControlFunctions a =>
[Char] -> a -> Either ParseError (Control' a)
parseControl [Char]
sourceName)
parseControl :: [Char] -> [Char] -> Either ParseError (Control' [Char])
parseControl [Char]
sourceName [Char]
c =
Parser (Control' [Char])
-> [Char] -> [Char] -> Either ParseError (Control' [Char])
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser (Control' [Char])
pControl [Char]
sourceName [Char]
c
lookupP :: [Char] -> Paragraph' [Char] -> Maybe (Field' [Char])
lookupP [Char]
fieldName (Paragraph [Field' [Char]]
paragraph) =
(Field' [Char] -> Bool) -> [Field' [Char]] -> Maybe (Field' [Char])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> Field' [Char] -> Bool
hasFieldName ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fieldName)) [Field' [Char]]
paragraph
where hasFieldName :: [Char] -> Field' [Char] -> Bool
hasFieldName [Char]
name (Field ([Char]
fieldName',[Char]
_)) = [Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fieldName'
hasFieldName [Char]
_ Field' [Char]
_ = Bool
False
stripWS :: [Char] -> [Char]
stripWS = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
strip ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
strip
where strip :: [Char] -> [Char]
strip = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Char -> [Char] -> Bool) -> [Char] -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Char]
" \t" :: [Char]))
protectFieldText :: [Char] -> [Char]
protectFieldText = [Char] -> [Char]
forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText'
asString :: [Char] -> [Char]
asString = [Char] -> [Char]
forall a. a -> a
id
type ControlParser a = CharParser () a
pControl :: ControlParser Control
pControl :: Parser (Control' [Char])
pControl =
do ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char])
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
ParsecT [Char] () Identity (Paragraph' [Char])
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Paragraph' [Char]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy ParsecT [Char] () Identity (Paragraph' [Char])
pParagraph ParsecT [Char] () Identity [Char]
pBlanks ParsecT [Char] () Identity [Paragraph' [Char]]
-> ([Paragraph' [Char]] -> Parser (Control' [Char]))
-> Parser (Control' [Char])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Control' [Char] -> Parser (Control' [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Control' [Char] -> Parser (Control' [Char]))
-> ([Paragraph' [Char]] -> Control' [Char])
-> [Paragraph' [Char]]
-> Parser (Control' [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Paragraph' [Char]] -> Control' [Char]
forall a. [Paragraph' a] -> Control' a
Control
pParagraph :: ControlParser Paragraph
pParagraph :: ParsecT [Char] () Identity (Paragraph' [Char])
pParagraph = ParsecT [Char] () Identity (Field' [Char])
-> ParsecT [Char] () Identity [Field' [Char]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] () Identity (Field' [Char])
pComment ParsecT [Char] () Identity (Field' [Char])
-> ParsecT [Char] () Identity (Field' [Char])
-> ParsecT [Char] () Identity (Field' [Char])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity (Field' [Char])
pField) ParsecT [Char] () Identity [Field' [Char]]
-> ([Field' [Char]]
-> ParsecT [Char] () Identity (Paragraph' [Char]))
-> ParsecT [Char] () Identity (Paragraph' [Char])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Paragraph' [Char] -> ParsecT [Char] () Identity (Paragraph' [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Paragraph' [Char]
-> ParsecT [Char] () Identity (Paragraph' [Char]))
-> ([Field' [Char]] -> Paragraph' [Char])
-> [Field' [Char]]
-> ParsecT [Char] () Identity (Paragraph' [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Field' [Char]] -> Paragraph' [Char]
forall a. [Field' a] -> Paragraph' a
Paragraph
pField :: ControlParser Field
pField :: ParsecT [Char] () Identity (Field' [Char])
pField =
do Char
c1 <- [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"#\n"
[Char]
fieldName <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char])
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
":\n"
Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
[Char]
fieldValue <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] () Identity Char
fcharfws
(Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity () -> ParsecT [Char] () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT [Char] () Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ParsecT [Char] () Identity ()
-> ParsecT [Char] () Identity () -> ParsecT [Char] () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
Field' [Char] -> ParsecT [Char] () Identity (Field' [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Field' [Char] -> ParsecT [Char] () Identity (Field' [Char]))
-> Field' [Char] -> ParsecT [Char] () Identity (Field' [Char])
forall a b. (a -> b) -> a -> b
$ ([Char], [Char]) -> Field' [Char]
forall a. (a, a) -> Field' a
Field (Char
c1 Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
fieldName, [Char]
fieldValue)
pComment :: ControlParser Field
=
do Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
[Char]
text <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'\n')))
Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
Field' [Char] -> ParsecT [Char] () Identity (Field' [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (Field' [Char] -> ParsecT [Char] () Identity (Field' [Char]))
-> Field' [Char] -> ParsecT [Char] () Identity (Field' [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Field' [Char]
forall a. a -> Field' a
Comment ([Char]
"#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
text [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")
fcharfws :: ControlParser Char
fcharfws :: ParsecT [Char] () Identity Char
fcharfws = ParsecT [Char] () Identity Char
fchar ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n ") ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n') ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n\t") ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n') ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] () Identity Char -> ParsecT [Char] () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char)
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n#") ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')
fchar :: ControlParser Char
fchar :: ParsecT [Char] () Identity Char
fchar = (Char -> Bool) -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n')
_fws :: ControlParser String
_fws :: ParsecT [Char] () Identity [Char]
_fws =
ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char])
-> ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall a b. (a -> b) -> a -> b
$ do Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
[Char]
ws <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
[Char]
c <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'\n')))
[Char] -> ParsecT [Char] () Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] () Identity [Char])
-> [Char] -> ParsecT [Char] () Identity [Char]
forall a b. (a -> b) -> a -> b
$ Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ([Char]
ws [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c)
pBlanks :: ControlParser String
pBlanks :: ParsecT [Char] () Identity [Char]
pBlanks = ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \n")