{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
module Debian.Control.Builder
(
Control'(..)
, Paragraph'(..)
, Field'(..)
, Control
, Paragraph
, Field
, ControlFunctions(..)
, mergeControls
, fieldValue
, removeField
, prependFields
, appendFields
, renameField
, modifyField
, raiseFields
, decodeControl
, decodeParagraph
, decodeField
) where
import qualified Data.ByteString.Char8 as B
import Data.Char (toLower, chr)
import Data.List (find)
import qualified Data.ListLike as LL
import Data.ListLike.Text.Builder ()
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
import qualified Debian.Control.ByteString as B
import Debian.Control.Common (ControlFunctions(parseControlFromFile, parseControlFromHandle, parseControl, lookupP, stripWS, asString),
Control'(Control), Paragraph'(Paragraph), Field'(Field, Comment),
mergeControls, fieldValue, removeField, prependFields, appendFields,
renameField, modifyField, raiseFields, protectFieldText')
type Field = Field' Builder
type Control = Control' Builder
type Paragraph = Paragraph' Builder
decodeControl :: B.Control -> Control
decodeControl :: Control -> Control
decodeControl (B.Control [Paragraph' ByteString]
paragraphs) = forall a. [Paragraph' a] -> Control' a
Control (forall a b. (a -> b) -> [a] -> [b]
map Paragraph' ByteString -> Paragraph
decodeParagraph [Paragraph' ByteString]
paragraphs)
decodeParagraph :: B.Paragraph -> Paragraph
decodeParagraph :: Paragraph' ByteString -> Paragraph
decodeParagraph (B.Paragraph [Field' ByteString]
s) = forall a. [Field' a] -> Paragraph' a
B.Paragraph (forall a b. (a -> b) -> [a] -> [b]
map Field' ByteString -> Field' Builder
decodeField [Field' ByteString]
s)
decodeField :: Field' B.ByteString -> Field' Builder
decodeField :: Field' ByteString -> Field' Builder
decodeField (B.Field (ByteString
name, ByteString
value)) = forall a. (a, a) -> Field' a
Field (ByteString -> Builder
decode ByteString
name, ByteString -> Builder
decode ByteString
value)
decodeField (B.Comment ByteString
s) = forall a. a -> Field' a
Comment (ByteString -> Builder
decode ByteString
s)
decode :: B.ByteString -> Builder
decode :: ByteString -> Builder
decode = Text -> Builder
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With (\ String
_ Maybe Word8
w -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Maybe Word8
w)
instance ControlFunctions Builder where
parseControlFromFile :: String -> IO (Either ParseError Control)
parseControlFromFile String
filepath =
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
filepath 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 c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control
decodeControl)
parseControlFromHandle :: String -> Handle -> IO (Either ParseError Control)
parseControlFromHandle String
sourceName Handle
handle =
forall a.
ControlFunctions a =>
String -> Handle -> IO (Either ParseError (Control' a))
parseControlFromHandle String
sourceName Handle
handle 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 c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control
decodeControl)
parseControl :: String -> Builder -> Either ParseError Control
parseControl String
sourceName Builder
c =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control
decodeControl) (forall a.
ControlFunctions a =>
String -> a -> Either ParseError (Control' a)
parseControl String
sourceName (Text -> ByteString
encodeUtf8 (Text -> Text
toStrict (Builder -> Text
toLazyText Builder
c))))
lookupP :: String -> Paragraph -> Maybe (Field' Builder)
lookupP String
fieldName (Paragraph [Field' Builder]
paragraph) =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Field' Builder -> Bool
hasFieldName (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fieldName)) [Field' Builder]
paragraph
where hasFieldName :: String -> Field' Builder -> Bool
hasFieldName :: String -> Field' Builder -> Bool
hasFieldName String
name (Field (Builder
fieldName',Builder
_)) = String
name forall a. Eq a => a -> a -> Bool
== forall full item full' item'.
(ListLike full item, ListLike full' item') =>
(item -> item') -> full -> full'
LL.map Char -> Char
toLower (forall s. StringLike s => s -> String
LL.toString Builder
fieldName')
hasFieldName String
_ Field' Builder
_ = Bool
False
stripWS :: Builder -> Builder
stripWS = forall c item. ListLike c item => (item -> Bool) -> c -> c
dropAround (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t" :: String))
protectFieldText :: Builder -> Builder
protectFieldText = forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText'
asString :: Builder -> String
asString = forall s. StringLike s => s -> String
LL.toString
dropAround :: LL.ListLike c item => (item -> Bool) -> c -> c
dropAround :: forall c item. ListLike c item => (item -> Bool) -> c -> c
dropAround item -> Bool
p = forall c item. ListLike c item => (item -> Bool) -> c -> c
LL.dropWhile item -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c item. ListLike c item => (item -> Bool) -> c -> c
LL.dropWhileEnd item -> Bool
p