{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

-- | Parse and serialize between FDF files and `Map [Text] Text`.

module Text.FDF (FDF (FDF, body), Field (Field, name, value, kids),
                 mapWithKey, mapFieldWithKey,
                 foldMapWithKey, foldMapFieldWithKey,
                 traverseWithKey, traverseFieldWithKey,
                 parse, serialize) where

import Control.Applicative ((<*), (<*>), (<|>), many, some, optional)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.Char (isSpace)
import Data.Monoid.Instances.ByteString.UTF8 (ByteStringUTF8 (ByteStringUTF8))
import Data.Monoid.Textual (toString, toText)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding (encodeUtf8)
import Rank2 qualified
import Text.Grampa
import Text.Grampa.Combinators
import Text.Parser.Combinators (manyTill)
import Text.Grampa.PEG.Backtrack qualified as PEG

type Parser = PEG.Parser (Rank2.Only FDF)

-- | Parsed FDF data structure
data FDF = FDF {
  FDF -> ByteString
header :: ByteString,
  FDF -> Field
body :: Field,
  FDF -> ByteString
trailer :: ByteString}
  deriving (Int -> FDF -> ShowS
[FDF] -> ShowS
FDF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FDF] -> ShowS
$cshowList :: [FDF] -> ShowS
show :: FDF -> String
$cshow :: FDF -> String
showsPrec :: Int -> FDF -> ShowS
$cshowsPrec :: Int -> FDF -> ShowS
Show)

-- | The body of FDF is a tree of nestable 'Field's.
data Field = Field {
  Field -> Text
name :: Text,
  Field -> Maybe Text
value :: Maybe Text,
  Field -> [Field]
kids :: [Field]}
  deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show)

mapWithKey :: ([Text] -> Text -> Text) -> FDF -> FDF
mapWithKey :: ([Text] -> Text -> Text) -> FDF -> FDF
mapWithKey [Text] -> Text -> Text
f x :: FDF
x@FDF{Field
body :: Field
body :: FDF -> Field
body} = FDF
x{body :: Field
body = ([Text] -> Text -> Text) -> Field -> Field
mapFieldWithKey [Text] -> Text -> Text
f Field
body}

mapFieldWithKey :: ([Text] -> Text -> Text) -> Field -> Field
mapFieldWithKey :: ([Text] -> Text -> Text) -> Field -> Field
mapFieldWithKey [Text] -> Text -> Text
f x :: Field
x@Field{Text
name :: Text
name :: Field -> Text
name, Maybe Text
value :: Maybe Text
value :: Field -> Maybe Text
value, [Field]
kids :: [Field]
kids :: Field -> [Field]
kids} =
  Field
x{value :: Maybe Text
value = [Text] -> Text -> Text
f [Text
name] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
value,
    kids :: [Field]
kids = ([Text] -> Text -> Text) -> Field -> Field
mapFieldWithKey ([Text] -> Text -> Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
nameforall a. a -> [a] -> [a]
:)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
kids}

foldMapWithKey :: Monoid a => ([Text] -> Text -> a) -> FDF -> a
foldMapWithKey :: forall a. Monoid a => ([Text] -> Text -> a) -> FDF -> a
foldMapWithKey [Text] -> Text -> a
f x :: FDF
x@FDF{Field
body :: Field
body :: FDF -> Field
body} = forall a. Monoid a => ([Text] -> Text -> a) -> Field -> a
foldMapFieldWithKey [Text] -> Text -> a
f Field
body

foldMapFieldWithKey :: Monoid a => ([Text] -> Text -> a) -> Field -> a
foldMapFieldWithKey :: forall a. Monoid a => ([Text] -> Text -> a) -> Field -> a
foldMapFieldWithKey [Text] -> Text -> a
f x :: Field
x@Field{Text
name :: Text
name :: Field -> Text
name, Maybe Text
value :: Maybe Text
value :: Field -> Maybe Text
value, [Field]
kids :: [Field]
kids :: Field -> [Field]
kids} =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Text] -> Text -> a
f [Text
name]) Maybe Text
value forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Monoid a => ([Text] -> Text -> a) -> Field -> a
foldMapFieldWithKey forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
nameforall a. a -> [a] -> [a]
:)) [Field]
kids

traverseWithKey :: Applicative f => ([Text] -> Text -> f Text) -> FDF -> f FDF
traverseWithKey :: forall (f :: * -> *).
Applicative f =>
([Text] -> Text -> f Text) -> FDF -> f FDF
traverseWithKey [Text] -> Text -> f Text
f x :: FDF
x@FDF{Field
body :: Field
body :: FDF -> Field
body} = (\Field
body'-> FDF
x{body :: Field
body = Field
body'}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
Applicative f =>
([Text] -> Text -> f Text) -> Field -> f Field
traverseFieldWithKey [Text] -> Text -> f Text
f Field
body

traverseFieldWithKey :: Applicative f => ([Text] -> Text -> f Text) -> Field -> f Field
traverseFieldWithKey :: forall (f :: * -> *).
Applicative f =>
([Text] -> Text -> f Text) -> Field -> f Field
traverseFieldWithKey [Text] -> Text -> f Text
f x :: Field
x@Field{Text
name :: Text
name :: Field -> Text
name, Maybe Text
value :: Maybe Text
value :: Field -> Maybe Text
value, [Field]
kids :: [Field]
kids :: Field -> [Field]
kids} =
  Text -> Maybe Text -> [Field] -> Field
Field Text
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Text] -> Text -> f Text
f [Text
name]) Maybe Text
value forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *).
Applicative f =>
([Text] -> Text -> f Text) -> Field -> f Field
traverseFieldWithKey forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> f Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
nameforall a. a -> [a] -> [a]
:)) [Field]
kids

serialize :: FDF -> ByteString
serialize :: FDF -> ByteString
serialize FDF{ByteString
header :: ByteString
header :: FDF -> ByteString
header, Field
body :: Field
body :: FDF -> Field
body, ByteString
trailer :: ByteString
trailer :: FDF -> ByteString
trailer} =
  ByteString
"%FDF-1.2\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
header
  forall a. Semigroup a => a -> a -> a
<> ByteString
"<<\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
"/FDF\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
"<<\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
"/Fields [\n"
  forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 (Field -> Text
serializeField Field
body) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
"]\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
">>\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
">>\n"
  forall a. Semigroup a => a -> a -> a
<> ByteString
trailer
  forall a. Semigroup a => a -> a -> a
<> ByteString
"%%EOF\n"

serializeField :: Field -> Text
serializeField :: Field -> Text
serializeField Field{Text
name :: Text
name :: Field -> Text
name, Maybe Text
value :: Maybe Text
value :: Field -> Maybe Text
value, [Field]
kids :: [Field]
kids :: Field -> [Field]
kids} =
  Text
"<<\n"
  forall a. Semigroup a => a -> a -> a
<> Text
"/T (" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
")\n"
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
v-> Text
"/V (" forall a. Semigroup a => a -> a -> a
<> Text
v forall a. Semigroup a => a -> a -> a
<> Text
")\n") Maybe Text
value
  forall a. Semigroup a => a -> a -> a
<> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Field]
kids then Text
"" else Text
"/Kids [\n" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"\n" (Field -> Text
serializeField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Field]
kids) forall a. Semigroup a => a -> a -> a
<> Text
"]\n")
  forall a. Semigroup a => a -> a -> a
<> Text
">>"

parse :: ByteString -> Either String FDF
parse :: ByteString -> Either String FDF
parse ByteString
input =
  forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (\ParseFailure Pos ByteStringUTF8
failure-> forall t. TextualMonoid t => (t -> String) -> t -> String
toString (forall a b. a -> b -> a
const String
"<?>") forall a b. (a -> b) -> a -> b
$ forall s pos.
(Ord s, TextualMonoid s, Position pos) =>
s -> ParseFailure pos s -> Int -> s
failureDescription ByteStringUTF8
s ParseFailure Pos ByteStringUTF8
failure Int
4) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall r (p :: ((* -> *) -> *) -> * -> * -> *) s (f :: * -> *).
(Only r (p (Only r) s) -> s -> Only r f)
-> p (Only r) s r -> s -> f r
simply forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
 FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete Parser ByteStringUTF8 FDF
parser ByteStringUTF8
s
  where s :: ByteStringUTF8
s = ByteString -> ByteStringUTF8
ByteStringUTF8 ByteString
input

parser :: Parser ByteStringUTF8 FDF
parser :: Parser ByteStringUTF8 FDF
parser = ByteString -> Field -> ByteString -> FDF
FDF
  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"%FDF-1.2" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"first line")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 ByteString
extract ((forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
takeWhile1 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ByteStringUTF8
"\r", ByteStringUTF8
"\n"]) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"bytes")
               forall a. Semigroup a => a -> a -> a
<> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
line Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
begin) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"header")
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/FDF" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end header")
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
begin
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/Fields [" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"fields")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteStringUTF8 Field
field
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"]" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end the fields")
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
end forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end the body")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 ByteString
extract ((Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
end forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end the object")
               forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"endobj" forall a. Semigroup a => a -> a -> a
<> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd
               forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile Char -> Bool
isSpace
               forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"trailer" forall a. Semigroup a => a -> a -> a
<> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd
               forall a. Semigroup a => a -> a -> a
<> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
line (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"%%EOF" forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"last line"))
               forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"trailer")
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd

field :: Parser ByteStringUTF8 Field
field :: Parser ByteStringUTF8 Field
field = Text -> Maybe Text -> [Field] -> Field
Field forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
begin
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 Text
strictText (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/T (" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
')', Char
'\r', Char
'\n']) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
")" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"name")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 Text
strictText forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
CommittedParsing m =>
m (CommittedResults m a) -> m a
admit (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/V (" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a.
CommittedParsing m =>
m a -> m (CommittedResults m a)
commit (forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
')', Char
'\r', Char
'\n']) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
")" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd)
                                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/V /" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a.
CommittedParsing m =>
m a -> m (CommittedResults m a)
commit (forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\r', Char
'\n']) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd)
                                    forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"value"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
CommittedParsing m =>
m (CommittedResults m a) -> m a
admit (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"/Kids [" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a.
CommittedParsing m =>
m a -> m (CommittedResults m a)
commit (Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome Parser ByteStringUTF8 Field
field forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"]" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"kids")
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a.
CommittedParsing m =>
m a -> m (CommittedResults m a)
commit forall a. Monoid a => a
mempty)
  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
end

begin :: Parser ByteStringUTF8 ByteStringUTF8
begin :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
begin = forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"<<" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"<<"

end :: Parser ByteStringUTF8 ByteStringUTF8
end :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
end = forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
">>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. (Alternative p, Monoid a) => p a -> p a
moptional Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
">>"

line :: Parser ByteStringUTF8 ByteStringUTF8
line :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
line = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
takeCharsWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\r', Char
'\n']) forall a. Semigroup a => a -> a -> a
<> Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"line"

lineEnd :: Parser ByteStringUTF8 ByteStringUTF8
lineEnd :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
lineEnd = forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"\r\n" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"\r" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
string ByteStringUTF8
"\n"

strictText :: Parser ByteStringUTF8 ByteStringUTF8 -> Parser ByteStringUTF8 Text
strictText :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 Text
strictText = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall t. TextualMonoid t => (t -> Text) -> t -> Text
toText (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Invalid UTF-8 sequence: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

extract :: Parser ByteStringUTF8 ByteStringUTF8 -> Parser ByteStringUTF8 ByteString
extract :: Parser (Only FDF) ByteStringUTF8 ByteStringUTF8
-> Parser ByteStringUTF8 ByteString
extract = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \(ByteStringUTF8 ByteString
bs) -> ByteString
bs