{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}

module Construct
(
  -- * The type
  Format, parse, serialize,

  -- * Combinators
  (Construct.<$), (Construct.*>), (Construct.<*), (Construct.<|>), (<+>), (<?>),
  empty, optional, optionWithDefault, pair, deppair, many, some, sepBy, count,
  -- ** Self-referential record support
  mfix, record, recordWith,
  -- ** Mapping over a 'Format'
  mapSerialized, mapMaybeSerialized, mapValue, mapMaybeValue,
  -- ** Constraining a 'Format'
  satisfy, value, padded, padded1,

  -- * Primitives
  literal, byte, char,
  cereal, cereal',
  Construct.take, Construct.takeWhile, Construct.takeWhile1, Construct.takeCharsWhile, Construct.takeCharsWhile1,
  -- * Test helpers
  testParse, testSerialize
) where

import qualified Control.Applicative as Applicative
import qualified Control.Monad.Fix as Monad.Fix
import Control.Applicative (Applicative, Alternative)
import Control.Monad.Fix (MonadFix)
import Data.Functor ((<$>), void)
import qualified Data.Functor.Const as Functor
import qualified Data.Functor.Identity as Functor
import qualified Data.List as List
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe)
import Data.Monoid (Ap(Ap, getAp))
import Data.Semigroup (Semigroup, (<>), sconcat)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual
import qualified Data.Monoid.Null as Null
import Data.Monoid.Factorial (FactorialMonoid)
import Data.Monoid.Textual (TextualMonoid)
import Data.String (IsString, fromString)
import qualified Text.Parser.Combinators as Parser
import qualified Text.Parser.Char as Parser.Char
import qualified Text.ParserCombinators.Incremental as Incremental
import Text.ParserCombinators.Incremental.Symmetric (Symmetric)
import Data.Serialize (Serialize, Result(Done, Fail, Partial), Get, Putter, runGetPartial, runPut)
import qualified Data.Serialize as Serialize
import Text.Parser.Input (InputParsing (ParserInput), InputCharParsing)
import qualified Text.Parser.Input as Input

import qualified Rank2

import Construct.Classes (AlternativeFail(failure), InputMappableParsing(mapParserInput, mapMaybeParserInput),
                          FixTraversable(fixSequence), Error,
                          errorString, expectedName)
import Construct.Internal

import Prelude hiding (pred, take, takeWhile)

-- $setup
-- >>> import Data.Char (isDigit, isLetter)
-- >>> import Data.Serialize.Get (getWord16le)
-- >>> import Data.Serialize.Put (putWord16le)
-- >>> import Data.Word (Word16)
-- >>> import Numeric (showInt)

literal  :: (Functor m, InputParsing m, Applicative n, ParserInput m ~ s) => s -> Format m n s ()
-- | A literal serialized form, such as a magic constant, corresponding to no value
--
-- >>> testParse (literal "Hi") "Hi there"
-- Right [(()," there")]
literal :: forall (m :: * -> *) (n :: * -> *) s.
(Functor m, InputParsing m, Applicative n, ParserInput m ~ s) =>
s -> Format m n s ()
literal s
s = Format{
   parse :: m ()
parse = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
s),
   serialize :: () -> n s
serialize = forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s)
   }

-- | Modifies the serialized form of the given format by padding it with the given template if it's any shorter
--
-- >>> testParse (padded "----" $ takeCharsWhile isDigit) "12--3---"
-- Right [("12","3---")]
-- >>> testSerialize (padded "----" $ takeCharsWhile isDigit) "12"
-- Right "12--"
padded :: (Monad m, Functor n, InputParsing m, ParserInput m ~ s, FactorialMonoid s) =>
          s -> Format m n s s -> Format m n s s
padded :: forall (m :: * -> *) (n :: * -> *) s.
(Monad m, Functor n, InputParsing m, ParserInput m ~ s,
 FactorialMonoid s) =>
s -> Format m n s s -> Format m n s s
padded s
template Format m n s s
format = Format{
   parse :: m s
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s s
format forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
parsePadding,
   serialize :: s -> n s
serialize = (s -> s
padRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s s
format
   }
   where padRight :: s -> s
padRight s
s = s
s forall a. Semigroup a => a -> a -> a
<> forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
s) s
template
         parsePadding :: s -> m s
parsePadding s
s = if forall m. MonoidNull m => m -> Bool
Null.null s
padding then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s else s
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
padding
            where padding :: s
padding = forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
s) s
template

-- | Modifies the serialized form of the given format by padding it with the given template. The serialized form has
-- to be shorter than the template before padding.
padded1 :: (Monad m, Monad n, InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) =>
           s -> Format m n s s -> Format m n s s
padded1 :: forall (m :: * -> *) (n :: * -> *) s.
(Monad m, Monad n, InputParsing m, ParserInput m ~ s,
 FactorialMonoid s, Show s, AlternativeFail n) =>
s -> Format m n s s -> Format m n s s
padded1 s
template Format m n s s
format = Format{
   parse :: m s
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s s
format forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
parsePadding,
   serialize :: s -> n s
serialize = \s
a-> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s s
format s
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> n s
padRight
   }
   where padRight :: s -> n s
padRight s
s = if forall m. MonoidNull m => m -> Bool
Null.null s
padding then forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"padded1 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show s
template) (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
                      else forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s forall a. Semigroup a => a -> a -> a
<> s
padding)
            where padding :: s
padding = forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
s) s
template
         parsePadding :: s -> m s
parsePadding s
s = if forall m. MonoidNull m => m -> Bool
Null.null s
padding
                          then forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (forall a. Show a => a -> String
show s
s) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
Parser.<?> (String
"padded1 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show s
template)
                          else s
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
padding
            where padding :: s
padding = forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (forall m. Factorial m => m -> Int
Factorial.length s
s) s
template

-- | Format whose in-memory value is a fixed-size prefix of the serialized value
--
-- >>> testParse (take 3) "12345"
-- Right [("123","45")]
-- >>> testSerialize (take 3) "123"
-- Right "123"
-- >>> testSerialize (take 3) "1234"
-- Left "expected a value of length 3, encountered \"1234\""
take :: (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) => Int -> Format m n s s
take :: forall (m :: * -> *) s (n :: * -> *).
(InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s,
 AlternativeFail n) =>
Int -> Format m n s s
take Int
n = Format{
   parse :: m s
parse = forall (m :: * -> *). InputParsing m => Int -> m (ParserInput m)
Input.take Int
n,
   serialize :: s -> n s
serialize = \s
s-> if forall m. Factorial m => m -> Int
Factorial.length s
s forall a. Eq a => a -> a -> Bool
== Int
n then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"a value of length " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n) (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
   }

-- | Format whose in-memory value is the longest prefix of the serialized value smallest parts of which all satisfy
-- the given predicate.
--
-- >>> testParse (takeWhile (> "b")) "abcd"
-- Right [("","abcd")]
-- >>> testParse (takeWhile (> "b")) "dcba"
-- Right [("dc","ba")]
-- >>> testSerialize (takeWhile (> "b")) "dcba"
-- Left "expected takeWhile, encountered \"dcba\""
-- >>> testSerialize (takeWhile (> "b")) "dc"
-- Right "dc"
-- >>> testSerialize (takeWhile (> "b")) ""
-- Right ""
takeWhile :: (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) =>
             (s -> Bool) -> Format m n s s
takeWhile :: forall (m :: * -> *) s (n :: * -> *).
(InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s,
 AlternativeFail n) =>
(s -> Bool) -> Format m n s s
takeWhile s -> Bool
pred = Format{
   parse :: m s
parse = forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
Input.takeWhile s -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if forall m. MonoidNull m => m -> Bool
Null.null (forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.dropWhile s -> Bool
pred s
s) then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeWhile" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
   }

-- | Format whose in-memory value is the longest non-empty prefix of the serialized value smallest parts of which all
-- satisfy the given predicate.
--
-- >>> testParse (takeWhile1 (> "b")) "abcd"
-- Left "takeWhile1"
-- >>> testSerialize (takeWhile1 (> "b")) ""
-- Left "expected takeWhile1, encountered \"\""
-- >>> testSerialize (takeWhile1 (> "b")) "dc"
-- Right "dc"
takeWhile1 :: (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) =>
              (s -> Bool) -> Format m n s s
takeWhile1 :: forall (m :: * -> *) s (n :: * -> *).
(InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s,
 AlternativeFail n) =>
(s -> Bool) -> Format m n s s
takeWhile1 s -> Bool
pred = Format{
   parse :: m s
parse = forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
Input.takeWhile1 s -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if Bool -> Bool
not (forall m. MonoidNull m => m -> Bool
Null.null s
s) Bool -> Bool -> Bool
&& forall m. MonoidNull m => m -> Bool
Null.null (forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.dropWhile s -> Bool
pred s
s) then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeWhile1" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
   }

-- | Format whose in-memory value is the longest prefix of the serialized value that consists of characters which all
-- satisfy the given predicate.
--
-- >>> testParse (takeCharsWhile isDigit) "a12"
-- Right [("","a12")]
-- >>> testParse (takeCharsWhile isDigit) "12a"
-- Right [("12","a")]
-- >>> testSerialize (takeCharsWhile isDigit) "12a"
-- Left "expected takeCharsWhile, encountered \"12a\""
-- >>> testSerialize (takeCharsWhile isDigit) "12"
-- Right "12"
-- >>> testSerialize (takeCharsWhile isDigit) ""
-- Right ""
takeCharsWhile :: (InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s, AlternativeFail n) =>
                  (Char -> Bool) -> Format m n s s
takeCharsWhile :: forall (m :: * -> *) s (n :: * -> *).
(InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s,
 AlternativeFail n) =>
(Char -> Bool) -> Format m n s s
takeCharsWhile Char -> Bool
pred = Format{
   parse :: m s
parse = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
Input.takeCharsWhile Char -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if forall m. MonoidNull m => m -> Bool
Null.null (forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.dropWhile_ Bool
False Char -> Bool
pred s
s) then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeCharsWhile" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
   }

-- | Format whose in-memory value is the longest non-empty prefix of the serialized value that consists of characters
-- which all satisfy the given predicate.
--
-- >>> testParse (takeCharsWhile1 isDigit) "a12"
-- Left "takeCharsWhile1 encountered 'a'"
-- >>> testParse (takeCharsWhile1 isDigit) "12a"
-- Right [("12","a")]
-- >>> testSerialize (takeCharsWhile1 isDigit) "12"
-- Right "12"
-- >>> testSerialize (takeCharsWhile1 isDigit) ""
-- Left "expected takeCharsWhile1, encountered \"\""
takeCharsWhile1 :: (InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s, AlternativeFail n) =>
                   (Char -> Bool) -> Format m n s s
takeCharsWhile1 :: forall (m :: * -> *) s (n :: * -> *).
(InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s,
 AlternativeFail n) =>
(Char -> Bool) -> Format m n s s
takeCharsWhile1 Char -> Bool
pred = Format{
   parse :: m s
parse = forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
Input.takeCharsWhile1 Char -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if Bool -> Bool
not (forall m. MonoidNull m => m -> Bool
Null.null s
s) Bool -> Bool -> Bool
&& forall m. MonoidNull m => m -> Bool
Null.null (forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.dropWhile_ Bool
False Char -> Bool
pred s
s) then forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeCharsWhile1" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show s
s)
   }

value :: (Eq a, Show a, Parser.Parsing m, Monad m, Alternative n) => Format m n s a -> a -> Format m n s ()
-- | A fixed expected value serialized through the argument format
--
-- >>> testParse (value char 'a') "bcd"
-- Left "encountered 'b'"
-- >>> testParse (value char 'a') "abc"
-- Right [((),"bc")]
value :: forall a (m :: * -> *) (n :: * -> *) s.
(Eq a, Show a, Parsing m, Monad m, Alternative n) =>
Format m n s a -> a -> Format m n s ()
value Format m n s a
f a
v = Format{
   parse :: m ()
parse = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x-> if a
x forall a. Eq a => a -> a -> Bool
== a
v then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x else forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (forall a. Show a => a -> String
show a
x)),
   serialize :: () -> n s
serialize = \()-> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
v
   }

satisfy :: (Parser.Parsing m, Monad m, AlternativeFail n, Show a) => (a -> Bool) -> Format m n s a -> Format m n s a
-- | Filter the argument format so it only succeeds for values that pass the predicate.
--
-- >>> testParse (satisfy isDigit char) "abc"
-- Left "encountered 'a'"
-- >>> testParse (satisfy isLetter char) "abc"
-- Right [('a',"bc")]
satisfy :: forall (m :: * -> *) (n :: * -> *) a s.
(Parsing m, Monad m, AlternativeFail n, Show a) =>
(a -> Bool) -> Format m n s a -> Format m n s a
satisfy a -> Bool
predicate Format m n s a
f = Format{
   parse :: m a
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v-> if a -> Bool
predicate a
v then forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v else forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (forall a. Show a => a -> String
show a
v),
   serialize :: a -> n s
serialize = \a
v-> if a -> Bool
predicate a
v then forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
v else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"satisfy" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
v)
   }

-- | Converts a format for serialized streams of type @s@ so it works for streams of type @t@ instead
--
-- >>> testParse (mapSerialized ByteString.unpack ByteString.pack byte) [1,2,3]
-- Right [(1,[2,3])]
mapSerialized :: (Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
                  s ~ ParserInput (m s), t ~ ParserInput (m t), InputMappableParsing m, Functor n) =>
                 (s -> t) -> (t -> s) -> Format (m s) n s a -> Format (m t) n t a
mapSerialized :: forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> t) -> (t -> s) -> Format (m s) n s a -> Format (m t) n t a
mapSerialized s -> t
f t -> s
f' Format (m s) n s a
format = Format{
   parse :: m t a
parse = forall (m :: * -> * -> *) s s' a.
(InputMappableParsing m, InputParsing (m s), s ~ ParserInput (m s),
 Monoid s, Monoid s') =>
(s -> s') -> (s' -> s) -> m s a -> m s' a
mapParserInput s -> t
f t -> s
f' (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format (m s) n s a
format),
   serialize :: a -> n t
serialize = (s -> t
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format (m s) n s a
format}

-- | Converts a format for serialized streams of type @s@ so it works for streams of type @t@ instead. The argument
-- functions may return @Nothing@ to indicate they have insuficient input to perform the conversion.
mapMaybeSerialized :: (Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
                       s ~ ParserInput (m s), t ~ ParserInput (m t), InputMappableParsing m, Functor n) =>
                      (s -> Maybe t) -> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized :: forall s t (m :: * -> * -> *) (n :: * -> *) a.
(Monoid s, Monoid t, InputParsing (m s), InputParsing (m t),
 s ~ ParserInput (m s), t ~ ParserInput (m t),
 InputMappableParsing m, Functor n) =>
(s -> Maybe t)
-> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a
mapMaybeSerialized s -> Maybe t
f t -> Maybe s
f' Format (m s) n s a
format = Format{
   parse :: m t a
parse = forall (m :: * -> * -> *) s s' a.
(InputMappableParsing m, InputParsing (m s), s ~ ParserInput (m s),
 Monoid s, Monoid s') =>
(s -> Maybe s') -> (s' -> Maybe s) -> m s a -> m s' a
mapMaybeParserInput s -> Maybe t
f t -> Maybe s
f' (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format (m s) n s a
format),
   serialize :: a -> n t
serialize = (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Partial serialization") forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe t
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format (m s) n s a
format}

-- | Converts a format for in-memory values of type @a@ so it works for values of type @b@ instead.
--
-- >>> testParse (mapValue (read @Int) show $ takeCharsWhile1 isDigit) "012 34"
-- Right [(12," 34")]
-- >>> testSerialize (mapValue read show $ takeCharsWhile1 isDigit) 12
-- Right "12"
mapValue :: Functor m => (a -> b) -> (b -> a) -> Format m n s a -> Format m n s b
mapValue :: forall (m :: * -> *) a b (n :: * -> *) s.
Functor m =>
(a -> b) -> (b -> a) -> Format m n s a -> Format m n s b
mapValue a -> b
f b -> a
f' Format m n s a
format = Format{
   parse :: m b
parse = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format,
   serialize :: b -> n s
serialize = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f'}

-- | Converts a format for in-memory values of type @a@ so it works for values of type @b@ instead. The argument
-- functions may signal conversion failure by returning @Nothing@.
mapMaybeValue :: (Monad m, Parser.Parsing m, Show a, Show b, AlternativeFail n) =>
                 (a -> Maybe b) -> (b -> Maybe a) -> Format m n s a -> Format m n s b
mapMaybeValue :: forall (m :: * -> *) a b (n :: * -> *) s.
(Monad m, Parsing m, Show a, Show b, AlternativeFail n) =>
(a -> Maybe b)
-> (b -> Maybe a) -> Format m n s a -> Format m n s b
mapMaybeValue a -> Maybe b
f b -> Maybe a
f' Format m n s a
format = Format{
   parse :: m b
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v-> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
v) forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
f a
v),
   serialize :: b -> n s
serialize = \b
v-> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"mapMaybeValue" (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show b
v)) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format) (b -> Maybe a
f' b
v)}

byte :: (InputParsing m, ParserInput m ~ ByteString, Applicative n) => Format m n ByteString Word8
-- | A trivial format for a single byte in a 'ByteString'
--
-- >>> testParse byte (ByteString.pack [1,2,3])
-- Right [(1,"\STX\ETX")]
byte :: forall (m :: * -> *) (n :: * -> *).
(InputParsing m, ParserInput m ~ ByteString, Applicative n) =>
Format m n ByteString Word8
byte = Format{
   parse :: m Word8
parse = HasCallStack => ByteString -> Word8
ByteString.head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). InputParsing m => m (ParserInput m)
Input.anyToken,
   serialize :: Word8 -> n ByteString
serialize = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
ByteString.singleton}

char     :: (Parser.Char.CharParsing m, ParserInput m ~ s, IsString s, Applicative n) => Format m n s Char
-- | A trivial format for a single character
--
-- >>> testParse char "abc"
-- Right [('a',"bc")]
char :: forall (m :: * -> *) s (n :: * -> *).
(CharParsing m, ParserInput m ~ s, IsString s, Applicative n) =>
Format m n s Char
char = Format{
   parse :: m Char
parse = forall (m :: * -> *). CharParsing m => m Char
Parser.Char.anyChar,
   serialize :: Char -> n s
serialize = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])}

cereal :: (Serialize a, Monad m, InputParsing m, ParserInput m ~ ByteString, Applicative n) => Format m n ByteString a
-- | A quick way to format a value that already has an appropriate 'Serialize' instance
--
-- >>> testParse (cereal @Word16) (ByteString.pack [1,2,3])
-- Right [(258,"\ETX")]
-- >>> testSerialize cereal (1025 :: Word16)
-- Right "\EOT\SOH"
cereal :: forall a (m :: * -> *) (n :: * -> *).
(Serialize a, Monad m, InputParsing m, ParserInput m ~ ByteString,
 Applicative n) =>
Format m n ByteString a
cereal = forall (m :: * -> *) (n :: * -> *) a.
(Monad m, InputParsing m, ParserInput m ~ ByteString,
 Applicative n) =>
Get a -> Putter a -> Format m n ByteString a
cereal' forall t. Serialize t => Get t
Serialize.get forall t. Serialize t => Putter t
Serialize.put

cereal' :: (Monad m, InputParsing m, ParserInput m ~ ByteString, Applicative n) =>
            Get a -> Putter a -> Format m n ByteString a
-- | Specifying a formatter explicitly using the cereal getter and putter
--
-- >>> testParse (cereal' getWord16le putWord16le) (ByteString.pack [1,2,3])
-- Right [(513,"\ETX")]
cereal' :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, InputParsing m, ParserInput m ~ ByteString,
 Applicative n) =>
Get a -> Putter a -> Format m n ByteString a
cereal' Get a
get Putter a
put = forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format m a
p (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter a
put)
   where p :: m a
p = forall {m :: * -> *} {a}.
(ParserInput m ~ ByteString, Monad m, InputParsing m) =>
Result a -> m a
go (forall a. Get a -> ByteString -> Result a
runGetPartial Get a
get forall a. Monoid a => a
mempty)
            where go :: Result a -> m a
go (Fail String
msg ByteString
_) = forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected String
msg
                  go (Done a
r ByteString
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
                  go (Partial ByteString -> Result a
cont) = forall (m :: * -> *). InputParsing m => m (ParserInput m)
Input.anyToken forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result a -> m a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result a
cont

count :: (Applicative m, AlternativeFail n, Show a, Monoid s) => Int -> Format m n s a -> Format m n s [a]
-- | Repeats the argument format the given number of times.
--
-- >>> testParse (count 4 byte) (ByteString.pack [1,2,3,4,5])
-- Right [([1,2,3,4],"\ENQ")]
-- >>> testSerialize (count 4 byte) [1,2,3,4,5]
-- Left "expected a list of length 4, encountered [1,2,3,4,5]"
-- >>> testSerialize (count 4 byte) [1,2,3,4]
-- Right "\SOH\STX\ETX\EOT"
count :: forall (m :: * -> *) (n :: * -> *) a s.
(Applicative m, AlternativeFail n, Show a, Monoid s) =>
Int -> Format m n s a -> Format m n s [a]
count Int
n Format m n s a
item = Format{
   parse :: m [a]
parse = forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Parser.count (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
item),
   serialize :: [a] -> n s
serialize = \[a]
as-> if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as forall a. Eq a => a -> a -> Bool
== Int
n then forall a. Monoid a => [a] -> a
mconcat 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 (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
item) [a]
as
                     else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"a list of length " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n) (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show [a]
as)}

record :: (Rank2.Apply g, Rank2.Traversable g, FixTraversable m, Applicative n, Monoid s) =>
          g (Format m n s) -> Format m n s (g Functor.Identity)
-- | Converts a record of field formats into a single format of the whole record.
record :: forall (g :: (* -> *) -> *) (m :: * -> *) (n :: * -> *) s.
(Apply g, Traversable g, FixTraversable m, Applicative n,
 Monoid s) =>
g (Format m n s) -> Format m n s (g Identity)
record = forall (g :: (* -> *) -> *) (m :: * -> *) (n :: * -> *)
       (o :: * -> *) s.
(Apply g, Traversable g, FixTraversable m, Applicative n, Monoid s,
 Applicative o) =>
(forall a. o (n a) -> n a)
-> g (Format m n s) -> Format m n s (g o)
recordWith forall a. Identity a -> a
Functor.runIdentity

recordWith :: forall g m n o s. (Rank2.Apply g, Rank2.Traversable g, FixTraversable m, Applicative n, Monoid s,
                                 Applicative o) =>
              (forall a. o (n a) -> n a) -> g (Format m n s) -> Format m n s (g o)
-- | Converts a record of field formats into a single format of the whole record, a generalized form of 'record'.
recordWith :: forall (g :: (* -> *) -> *) (m :: * -> *) (n :: * -> *)
       (o :: * -> *) s.
(Apply g, Traversable g, FixTraversable m, Applicative n, Monoid s,
 Applicative o) =>
(forall a. o (n a) -> n a)
-> g (Format m n s) -> Format m n s (g o)
recordWith forall a. o (n a) -> n a
collapse g (Format m n s)
formats = Format{
   parse :: m (g o)
parse = forall (m :: * -> *) (g :: (* -> *) -> *) (n :: * -> *).
(FixTraversable m, Traversable g, Applicative n) =>
g m -> m (g n)
fixSequence (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *).
Functor g =>
(forall (a :: k). p a -> q a) -> g p -> g q
Rank2.<$> g (Format m n s)
formats),
   serialize :: g o -> n s
serialize = forall {k} (f :: k -> *) (a :: k). Ap f a -> f a
getAp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap forall {k} a (b :: k). Const a b -> a
Functor.getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (g :: (k -> *) -> *) (p :: k -> *) (q :: k -> *)
       (r :: k -> *).
Apply g =>
(forall (a :: k). p a -> q a -> r a) -> g p -> g q -> g r
Rank2.liftA2 forall a. Format m n s a -> o a -> Const (Ap n s) a
serializeField g (Format m n s)
formats
   }
   where serializeField :: forall a. Format m n s a -> o a -> Functor.Const (Ap n s) a
         serializeField :: forall a. Format m n s a -> o a -> Const (Ap n s) a
serializeField Format m n s a
format o a
xs = forall {k} a (b :: k). a -> Const a b
Functor.Const (forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap forall a b. (a -> b) -> a -> b
$ forall a. o (n a) -> n a
collapse (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> o a
xs))

infixl 3 <|>
infixl 4 <$
infixl 4 <*
infixl 4 *>

(<$) :: (Eq a, Show a, Functor m, AlternativeFail n) => a -> Format m n s () -> Format m n s a
-- | Same as the usual 'Data.Functor.<$' except a 'Format' is no 'Functor'.
a
a <$ :: forall a (m :: * -> *) (n :: * -> *) s.
(Eq a, Show a, Functor m, AlternativeFail n) =>
a -> Format m n s () -> Format m n s a
<$ Format m n s ()
f = Format{
   parse :: m a
parse = a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
f,
   serialize :: a -> n s
serialize = \a
b-> if a
a forall a. Eq a => a -> a -> Bool
== a
b then forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
f () else forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (forall a. Show a => a -> String
show a
a) (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
b)}

(*>) :: (Applicative m, Applicative n, Semigroup s) => Format m n s () -> Format m n s a -> Format m n s a
-- | Same as the usual 'Applicative.*>' except a 'Format' is no 'Functor', let alone 'Applicative'.
Format m n s ()
f1 *> :: forall (m :: * -> *) (n :: * -> *) s a.
(Applicative m, Applicative n, Semigroup s) =>
Format m n s () -> Format m n s a -> Format m n s a
*> Format m n s a
f2 = Format{
   parse :: m a
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
f1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Applicative.*> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f2,
   serialize :: a -> n s
serialize = \a
a-> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
f1 ()) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f2 a
a)}

(<*) :: (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s () -> Format m n s a
-- | Same as the usual 'Applicative.<*' except a 'Format' is no 'Functor', let alone 'Applicative'.
Format m n s a
f1 <* :: forall (m :: * -> *) (n :: * -> *) s a.
(Applicative m, Applicative n, Semigroup s) =>
Format m n s a -> Format m n s () -> Format m n s a
<* Format m n s ()
f2 = Format{
   parse :: m a
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
Applicative.<* forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
f2,
   serialize :: a -> n s
serialize = \a
a-> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1 a
a) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
f2 ())}

(<|>) :: (Alternative m, Alternative n) => Format m n s a -> Format m n s a -> Format m n s a
-- | Same as the usual 'Applicative.<|>' except a 'Format' is no 'Functor', let alone 'Alternative'.
Format m n s a
f1 <|> :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Alternative n) =>
Format m n s a -> Format m n s a -> Format m n s a
<|> Format m n s a
f2 = Format{
   parse :: m a
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f2,
   serialize :: a -> n s
serialize = \a
a-> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1 a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f2 a
a}

(<+>) :: Alternative m => Format m n s a -> Format m n s b -> Format m n s (Either a b)
-- | A discriminated or tagged choice between two formats.
Format m n s a
f1 <+> :: forall (m :: * -> *) (n :: * -> *) s a b.
Alternative m =>
Format m n s a -> Format m n s b -> Format m n s (Either a b)
<+> Format m n s b
f2 = Format{
   parse :: m (Either a b)
parse = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s b
f2,
   serialize :: Either a b -> n s
serialize = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s b
f2)}

optional :: (Alternative m, Alternative n, Monoid s) => Format m n s a -> Format m n s (Maybe a)
-- | Same as the usual 'Applicative.optional' except a 'Format' is no 'Functor', let alone 'Alternative'.
optional :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Alternative n, Monoid s) =>
Format m n s a -> Format m n s (Maybe a)
optional Format m n s a
f = Format{
   parse :: m (Maybe a)
parse = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f),
   serialize :: Maybe a -> n s
serialize = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f)}

-- | Like 'optional' except with arbitrary default serialization for the @Nothing@ value.
--
-- > optional = optionWithDefault (literal mempty)
optionWithDefault :: (Alternative m, Alternative n) => Format m n s () -> Format m n s a -> Format m n s (Maybe a)
optionWithDefault :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Alternative n) =>
Format m n s () -> Format m n s a -> Format m n s (Maybe a)
optionWithDefault Format m n s ()
d Format m n s a
f = Format{
   parse :: m (Maybe a)
parse = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
d,
   serialize :: Maybe a -> n s
serialize = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
d ()) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f)}

many :: (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s [a]
-- | Same as the usual 'Applicative.many' except a 'Format' is no 'Functor', let alone 'Alternative'.
many :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Applicative n, Monoid s) =>
Format m n s a -> Format m n s [a]
many Format m n s a
f = Format{
   parse :: m [a]
parse = forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f),
   serialize :: [a] -> n s
serialize = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f)}

some :: (Alternative m, AlternativeFail n, Semigroup s) => Format m n s a -> Format m n s [a]
-- | Same as the usual 'Applicative.some' except a 'Format' is no 'Functor', let alone 'Alternative'.
some :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, AlternativeFail n, Semigroup s) =>
Format m n s a -> Format m n s [a]
some Format m n s a
f = Format{
   parse :: m [a]
parse = forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.some (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f),
   serialize :: [a] -> n s
serialize = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure String
"[]") (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty}

sepBy :: (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s () -> Format m n s [a]
-- | Represents any number of values formatted using the first argument, separated by the second format argumewnt in
-- serialized form. Similar to the usual 'Parser.sepBy' combinator.
--
-- >>> testParse (takeCharsWhile isLetter `sepBy` literal ",") "foo,bar,baz"
-- Right [([],"foo,bar,baz"),(["foo"],",bar,baz"),(["foo","bar"],",baz"),(["foo","bar","baz"],"")]
sepBy :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Applicative n, Monoid s) =>
Format m n s a -> Format m n s () -> Format m n s [a]
sepBy Format m n s a
format Format m n s ()
separator = Format{
   parse :: m [a]
parse = forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
Parser.sepBy (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
separator),
   serialize :: [a] -> n s
serialize = \[a]
xs-> forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (forall a. a -> [a] -> [a]
List.intersperse (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
separator ()) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs)}

pair :: (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s b -> Format m n s (a, b)
-- | Combines two formats into a format for the pair of their values.
--
-- >>> testParse (pair char char) "abc"
-- Right [(('a','b'),"c")]
pair :: forall (m :: * -> *) (n :: * -> *) s a b.
(Applicative m, Applicative n, Semigroup s) =>
Format m n s a -> Format m n s b -> Format m n s (a, b)
pair Format m n s a
f Format m n s b
g = Format{
   parse :: m (a, b)
parse = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s b
g,
   serialize :: (a, b) -> n s
serialize = \(a
a, b
b)-> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
a) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s b
g b
b)}

deppair :: (Monad m, Applicative n, Semigroup s) => Format m n s a -> (a -> Format m n s b) -> Format m n s (a, b)
-- | Combines two formats, where the second format depends on the first value, into a format for the pair of their
-- values.  Similar to '>>=' except 'Format' is no 'Functor' let alone 'Monad'.
--
-- >>> testParse (deppair char (\c-> satisfy (==c) char)) "abc"
-- Left "encountered 'b'"
-- >>> testParse (deppair char (\c-> satisfy (==c) char)) "aac"
-- Right [(('a','a'),"c")]
deppair :: forall (m :: * -> *) (n :: * -> *) s a b.
(Monad m, Applicative n, Semigroup s) =>
Format m n s a -> (a -> Format m n s b) -> Format m n s (a, b)
deppair Format m n s a
f a -> Format m n s b
g = Format{
   parse :: m (a, b)
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a-> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse (a -> Format m n s b
g a
a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b-> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b),
   serialize :: (a, b) -> n s
serialize = \(a
a, b
b)-> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 forall a. Semigroup a => a -> a -> a
(<>) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
a) (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize (a -> Format m n s b
g a
a) b
b)}

empty :: (Alternative m, Alternative n) => Format m n s a
-- | Same as the usual 'Applicative.empty' except a 'Format' is no 'Functor', let alone 'Alternative'.
empty :: forall (m :: * -> *) (n :: * -> *) s a.
(Alternative m, Alternative n) =>
Format m n s a
empty = Format{
   parse :: m a
parse = forall (f :: * -> *) a. Alternative f => f a
Applicative.empty,
   serialize :: a -> n s
serialize = forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
Applicative.empty}

infixr 0 <?>
(<?>) :: (Parser.Parsing m, AlternativeFail n) => Format m n s a -> String -> Format m n s a
-- | Name a format to improve error messages.
--
-- >>> testParse (takeCharsWhile1 isDigit <?> "a number") "abc"
-- Left "expected a number, encountered 'a'"
-- >>> testSerialize (takeCharsWhile1 isDigit <?> "a number") "abc"
-- Left "expected a number, encountered \"abc\""
Format m n s a
f <?> :: forall (m :: * -> *) (n :: * -> *) s a.
(Parsing m, AlternativeFail n) =>
Format m n s a -> String -> Format m n s a
<?> String
name = Format{
   parse :: m a
parse = forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f forall (m :: * -> *) a. Parsing m => m a -> String -> m a
Parser.<?> String
name,
   serialize :: a -> n s
serialize = forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f}

mfix :: MonadFix m => (a -> Format m n s a) -> Format m n s a
-- | Same as the usual 'Control.Monad.Fix.mfix' except a 'Format' is no 'Functor', let alone 'Monad'.
mfix :: forall (m :: * -> *) a (n :: * -> *) s.
MonadFix m =>
(a -> Format m n s a) -> Format m n s a
mfix a -> Format m n s a
f = Format{
   parse :: m a
parse = forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
Monad.Fix.mfix (forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Format m n s a
f),
   serialize :: a -> n s
serialize = \a
a-> forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize (a -> Format m n s a
f a
a) a
a}

-- | Attempts to 'parse' the given input with the format with a constrained type, returns either a failure message or
-- a list of successes.
testParse :: Monoid s => Format (Incremental.Parser Symmetric s) (Either Error) s a -> s -> Either String [(a, s)]
testParse :: forall s a.
Monoid s =>
Format (Parser Symmetric s) (Either Error) s a
-> s -> Either String [(a, s)]
testParse Format (Parser Symmetric s) (Either Error) s a
format s
input = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t s r.
Parser t s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))
Incremental.inspect (forall s t r. Monoid s => Parser t s r -> Parser t s r
Incremental.feedEof forall a b. (a -> b) -> a -> b
$ forall s t r. Monoid s => s -> Parser t s r -> Parser t s r
Incremental.feed s
input forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format (Parser Symmetric s) (Either Error) s a
format)

-- | A less polymorphic wrapper around 'serialize' useful for testing
testSerialize :: Format (Incremental.Parser Symmetric s) (Either Error) s a -> a -> Either String s
testSerialize :: forall s a.
Format (Parser Symmetric s) (Either Error) s a
-> a -> Either String s
testSerialize Format (Parser Symmetric s) (Either Error) s a
format = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
errorString) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format (Parser Symmetric s) (Either Error) s a
format