{-# 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) = [Paragraph' Builder] -> Control
forall a. [Paragraph' a] -> Control' a
Control ((Paragraph' ByteString -> Paragraph' Builder)
-> [Paragraph' ByteString] -> [Paragraph' Builder]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph' ByteString -> Paragraph' Builder
decodeParagraph [Paragraph' ByteString]
paragraphs)
decodeParagraph :: B.Paragraph -> Paragraph
decodeParagraph :: Paragraph' ByteString -> Paragraph' Builder
decodeParagraph (B.Paragraph [Field' ByteString]
s) = [Field' Builder] -> Paragraph' Builder
forall a. [Field' a] -> Paragraph' a
B.Paragraph ((Field' ByteString -> Field' Builder)
-> [Field' ByteString] -> [Field' Builder]
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)) = (Builder, Builder) -> Field' Builder
forall a. (a, a) -> Field' a
Field (ByteString -> Builder
decode ByteString
name, ByteString -> Builder
decode ByteString
value)
decodeField (B.Comment ByteString
s) = Builder -> Field' Builder
forall a. a -> Field' a
Comment (ByteString -> Builder
decode ByteString
s)
decode :: B.ByteString -> Builder
decode :: ByteString -> Builder
decode = Text -> Builder
fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With (\ String
_ Maybe Word8
w -> (Word8 -> Char) -> Maybe Word8 -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
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 =
String -> IO (Either ParseError Control)
forall a.
ControlFunctions a =>
String -> IO (Either ParseError (Control' a))
parseControlFromFile String
filepath IO (Either ParseError Control)
-> (Either ParseError Control -> IO (Either ParseError Control))
-> IO (Either ParseError Control)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ParseError Control -> IO (Either ParseError Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError Control -> IO (Either ParseError Control))
-> (Either ParseError Control -> Either ParseError Control)
-> Either ParseError Control
-> IO (Either ParseError Control)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> Either ParseError Control)
-> (Control -> Either ParseError Control)
-> Either ParseError Control
-> Either ParseError Control
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError Control
forall a b. a -> Either a b
Left (Control -> Either ParseError Control
forall a b. b -> Either a b
Right (Control -> Either ParseError Control)
-> (Control -> Control) -> Control -> Either ParseError Control
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 =
String -> Handle -> IO (Either ParseError Control)
forall a.
ControlFunctions a =>
String -> Handle -> IO (Either ParseError (Control' a))
parseControlFromHandle String
sourceName Handle
handle IO (Either ParseError Control)
-> (Either ParseError Control -> IO (Either ParseError Control))
-> IO (Either ParseError Control)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ParseError Control -> IO (Either ParseError Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError Control -> IO (Either ParseError Control))
-> (Either ParseError Control -> Either ParseError Control)
-> Either ParseError Control
-> IO (Either ParseError Control)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> Either ParseError Control)
-> (Control -> Either ParseError Control)
-> Either ParseError Control
-> Either ParseError Control
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError Control
forall a b. a -> Either a b
Left (Control -> Either ParseError Control
forall a b. b -> Either a b
Right (Control -> Either ParseError Control)
-> (Control -> Control) -> Control -> Either ParseError Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control
decodeControl)
parseControl :: String -> Builder -> Either ParseError Control
parseControl String
sourceName Builder
c =
(ParseError -> Either ParseError Control)
-> (Control -> Either ParseError Control)
-> Either ParseError Control
-> Either ParseError Control
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Either ParseError Control
forall a b. a -> Either a b
Left (Control -> Either ParseError Control
forall a b. b -> Either a b
Right (Control -> Either ParseError Control)
-> (Control -> Control) -> Control -> Either ParseError Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Control
decodeControl) (String -> ByteString -> Either ParseError Control
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' Builder -> Maybe (Field' Builder)
lookupP String
fieldName (Paragraph [Field' Builder]
paragraph) =
(Field' Builder -> Bool)
-> [Field' Builder] -> Maybe (Field' Builder)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Field' Builder -> Bool
hasFieldName ((Char -> Char) -> String -> String
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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall full item full' item'.
(ListLike full item, ListLike full' item') =>
(item -> item') -> full -> full'
LL.map Char -> Char
toLower (Builder -> String
forall s. StringLike s => s -> String
LL.toString Builder
fieldName')
hasFieldName String
_ Field' Builder
_ = Bool
False
stripWS :: Builder -> Builder
stripWS = (Char -> Bool) -> Builder -> Builder
forall c item. ListLike c item => (item -> Bool) -> c -> c
dropAround (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t" :: String))
protectFieldText :: Builder -> Builder
protectFieldText = Builder -> Builder
forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText'
asString :: Builder -> String
asString = Builder -> String
forall s. StringLike s => s -> String
LL.toString
dropAround :: LL.ListLike c item => (item -> Bool) -> c -> c
dropAround :: (item -> Bool) -> c -> c
dropAround item -> Bool
p = (item -> Bool) -> c -> c
forall c item. ListLike c item => (item -> Bool) -> c -> c
LL.dropWhile item -> Bool
p (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (item -> Bool) -> c -> c
forall c item. ListLike c item => (item -> Bool) -> c -> c
LL.dropWhileEnd item -> Bool
p