{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
module Debian.Control.TextLazy
    ( -- * Types
      Control'(..)
    , Paragraph'(..)
    , Field'(..)
    , Control
    , Paragraph
    , Field
    -- , ControlParser
    , ControlFunctions(..)
    -- * Control File Parser
    -- , pControl
    -- * Helper Functions
    , 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.Text.Lazy as T (Text, pack, unpack, map, dropAround, {-reverse,-} fromStrict, toStrict)
import Data.Text.Encoding (decodeUtf8With, encodeUtf8)
--import Data.Text.IO as T (readFile)
import qualified Debian.Control.ByteString as B
--import Text.Parsec.Error (ParseError)
--import Text.Parsec.Text (Parser)
--import Text.Parsec.Prim (runP)
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')

-- | @parseFromFile p filePath@ runs a string parser @p@ on the
-- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'
-- ('Left') or a value of type @a@ ('Right').
--
-- >  main    = do{ result <- parseFromFile numbers "digits.txt"
-- >              ; case result of
-- >                  Left err  -> print err
-- >                  Right xs  -> print (sum xs)
-- >              }
{-
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname
    = do input <- T.readFile fname `E.catch` (\ (_ :: E.SomeException) -> B.readFile fname >>= return . decode)
         return (runP p () fname input)
-}

type Field = Field' T.Text
type Control = Control' T.Text
type Paragraph = Paragraph' T.Text

decodeControl :: B.Control -> Control
decodeControl :: Control -> Control
decodeControl (B.Control [Paragraph' ByteString]
paragraphs) = [Paragraph' Text] -> Control
forall a. [Paragraph' a] -> Control' a
Control ((Paragraph' ByteString -> Paragraph' Text)
-> [Paragraph' ByteString] -> [Paragraph' Text]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph' ByteString -> Paragraph' Text
decodeParagraph [Paragraph' ByteString]
paragraphs)

decodeParagraph :: B.Paragraph -> Paragraph
decodeParagraph :: Paragraph' ByteString -> Paragraph' Text
decodeParagraph (B.Paragraph [Field' ByteString]
s) = [Field' Text] -> Paragraph' Text
forall a. [Field' a] -> Paragraph' a
B.Paragraph ((Field' ByteString -> Field' Text)
-> [Field' ByteString] -> [Field' Text]
forall a b. (a -> b) -> [a] -> [b]
map Field' ByteString -> Field' Text
decodeField [Field' ByteString]
s)

decodeField :: Field' B.ByteString -> Field' T.Text
decodeField :: Field' ByteString -> Field' Text
decodeField (B.Field (ByteString
name, ByteString
value)) = (Text, Text) -> Field' Text
forall a. (a, a) -> Field' a
Field (ByteString -> Text
decode ByteString
name, ByteString -> Text
decode ByteString
value)
decodeField (B.Comment ByteString
s) = Text -> Field' Text
forall a. a -> Field' a
Comment (ByteString -> Text
decode ByteString
s)

decode :: B.ByteString -> T.Text
decode :: ByteString -> Text
decode = Text -> Text
T.fromStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
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)

-- * ControlFunctions

instance ControlFunctions T.Text where
    parseControlFromFile :: String -> IO (Either ParseError Control)
parseControlFromFile String
filepath =
        -- The ByteString parser is far more efficient than the Text
        -- parser.  By calling decodeControl we tell the compiler to
        -- use it instead.
        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 -> Text -> Either ParseError Control
parseControl String
sourceName Text
c =
        -- Warning: This is very slow, it does a utf8 round trip
        (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
T.toStrict Text
c)))
    lookupP :: String -> Paragraph' Text -> Maybe (Field' Text)
lookupP String
fieldName (Paragraph [Field' Text]
paragraph) =
        (Field' Text -> Bool) -> [Field' Text] -> Maybe (Field' Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Field' Text -> Bool
hasFieldName ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fieldName)) [Field' Text]
paragraph
        where hasFieldName :: String -> Field' T.Text -> Bool
              hasFieldName :: String -> Field' Text -> Bool
hasFieldName String
name (Field (Text
fieldName',Text
_)) = String -> Text
T.pack String
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
fieldName'
              hasFieldName String
_ Field' Text
_ = Bool
False
    stripWS :: Text -> Text
stripWS = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t" :: String))
      -- T.strip would also strip newlines
    protectFieldText :: Text -> Text
protectFieldText = Text -> Text
forall a.
(StringLike a, ListLike a Char, ControlFunctions a) =>
a -> a
protectFieldText'
    asString :: Text -> String
asString = Text -> String
T.unpack

-- * Control File Parser
{-
-- type ControlParser = GenParser T.Text
type ControlParser a = Parsec T.Text () 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 =
    do many $ char '\n'
       sepEndBy pParagraph pBlanks >>= return . Control

pParagraph :: ControlParser Paragraph
pParagraph = many1 (pComment <|> pField) >>= return . 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 =
    do c1 <- noneOf "#\n"
       fieldName <-  many1 $ noneOf ":\n"
       char ':'
       fieldValue <- many fcharfws
       (char '\n' >> return ()) <|> eof
       return $ Field (T.cons c1 (T.pack fieldName), T.pack fieldValue)

pComment :: ControlParser Field
pComment =
    do char '#'
       text <- many (satisfy (not . ((==) '\n')))
       char '\n'
       return $ Comment (T.pack ("#" <> text <> "\n"))

fcharfws :: ControlParser Char
fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')

fchar :: ControlParser Char
fchar = satisfy (/='\n')

_fws :: ControlParser T.Text
_fws =
    try $ do char '\n'
             ws <- many1 (char ' ')
             c <- many1 (satisfy (not . ((==) '\n')))
             return $ T.cons '\n' (T.pack ws <> T.pack c)

-- |We go with the assumption that 'blank lines' mean lines that
-- consist of entirely of zero or more whitespace characters.
pBlanks :: ControlParser T.Text
pBlanks =
    do s <- many1 (oneOf " \n")
       return . T.pack $ s
-}