{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
module Debian.Control.String
    ( -- * Types
      Control'(..)
    , Paragraph'(..)
    , Field'(..)
    , Control
    , Paragraph
    , Field
    , ControlParser
    , ControlFunctions(..)
    -- * Control File Parser
    , pControl
    -- * Helper Functions
    , 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

-- * ControlFunctions

instance ControlFunctions String where
    parseControlFromFile :: [Char] -> IO (Either ParseError (Control' [Char]))
parseControlFromFile [Char]
filepath =
        forall a. Parser a -> [Char] -> IO (Either ParseError a)
parseFromFile ControlParser (Control' [Char])
pControl [Char]
filepath
    parseControlFromHandle :: [Char] -> Handle -> IO (Either ParseError (Control' [Char]))
parseControlFromHandle [Char]
sourceName Handle
handle =
        forall e a. Exception e => IO a -> IO (Either e a)
E.try (Handle -> IO [Char]
hGetContents Handle
handle) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (SomeException
e :: E.SomeException) -> forall a. HasCallStack => [Char] -> a
error ([Char]
"parseControlFromHandle String: Failure parsing " forall a. [a] -> [a] -> [a]
++ [Char]
sourceName forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SomeException
e)) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
        forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse ControlParser (Control' [Char])
pControl [Char]
sourceName [Char]
c
    lookupP :: [Char] -> Paragraph' [Char] -> Maybe (Field' [Char])
lookupP [Char]
fieldName (Paragraph [Field' [Char]]
paragraph) =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> Field' [Char] -> Bool
hasFieldName (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 forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fieldName'
              hasFieldName [Char]
_ Field' [Char]
_ = Bool
False
    stripWS :: [Char] -> [Char]
stripWS = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
strip
        where strip :: [Char] -> [Char]
strip = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Char]
" \t" :: [Char]))
    protectFieldText :: [Char] -> [Char]
protectFieldText = forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText'
    asString :: [Char] -> [Char]
asString = forall a. a -> a
id

-- * Control File Parser

type ControlParser a = CharParser () a

-- |A parser for debian control file. This parser handles control files
-- that end without a newline as well as ones that have several blank
-- lines at the end. It is very liberal and does not attempt validate
-- the fields in any way. All trailing, leading, and folded whitespace
-- is preserved in the field values. See 'stripWS'.
pControl :: ControlParser Control
pControl :: ControlParser (Control' [Char])
pControl =
    do forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
       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 ControlParser (Paragraph' [Char])
pParagraph ParsecT [Char] () Identity [Char]
pBlanks forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Paragraph' a] -> Control' a
Control

pParagraph :: ControlParser Paragraph
pParagraph :: ControlParser (Paragraph' [Char])
pParagraph = 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 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) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Field' a] -> Paragraph' a
Paragraph

-- |We are liberal in that we allow *any* field to have folded white
-- space, even though the specific restricts that to a few fields.
pField :: ControlParser Field
pField :: ParsecT [Char] () Identity (Field' [Char])
pField =
    do Char
c1 <- forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"#\n"
       [Char]
fieldName <-  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
":\n"
       forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
       [Char]
fieldValue <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ControlParser Char
fcharfws
       (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a, a) -> Field' a
Field (Char
c1 forall a. a -> [a] -> [a]
: [Char]
fieldName, [Char]
fieldValue)

pComment :: ControlParser Field
pComment :: ParsecT [Char] () Identity (Field' [Char])
pComment =
    do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
       [Char]
text <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
(==) Char
'\n')))
       forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Field' a
Comment ([Char]
"#" forall a. [a] -> [a] -> [a]
++ [Char]
text forall a. [a] -> [a] -> [a]
++ [Char]
"\n")

fcharfws :: ControlParser Char
fcharfws :: ControlParser Char
fcharfws = ControlParser Char
fchar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n ") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n\t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\n#") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n')

fchar :: ControlParser Char
fchar :: ControlParser Char
fchar = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/=Char
'\n')

_fws :: ControlParser String
_fws :: ParsecT [Char] () Identity [Char]
_fws =
    forall tok st a. GenParser tok st a -> GenParser tok st a
try forall a b. (a -> b) -> a -> b
$ do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
             [Char]
ws <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
             [Char]
c <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
(==) Char
'\n')))
             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'\n' forall a. a -> [a] -> [a]
: ([Char]
ws forall a. [a] -> [a] -> [a]
++ [Char]
c)

-- |We go with the assumption that 'blank lines' mean lines that
-- consist of entirely of zero or more whitespace characters.
pBlanks :: ControlParser String
pBlanks :: ParsecT [Char] () Identity [Char]
pBlanks = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
" \n")