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

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 :: s -> Format m n s ()
literal s
s = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m ()
parse = m s -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
ParserInput m
s),
   serialize :: () -> n s
serialize = n s -> () -> n s
forall a b. a -> b -> a
const (s -> n s
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 :: s -> Format m n s s -> Format m n s s
padded s
template Format m n s s
format = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = Format m n s s -> m s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s s
format m s -> (s -> m s) -> m s
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 (s -> s) -> n s -> n s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (n s -> n s) -> (s -> n s) -> s -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format m n s s -> s -> n s
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 s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) s
template
         parsePadding :: s -> m s
parsePadding s
s = if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
padding then s -> m s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s else s
s s -> m s -> m s
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
ParserInput m
padding
            where padding :: s
padding = Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
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 :: s -> Format m n s s -> Format m n s s
padded1 s
template Format m n s s
format = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = Format m n s s -> m s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s s
format m s -> (s -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m s
parsePadding,
   serialize :: s -> n s
serialize = \s
a-> Format m n s s -> s -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s s
format s
a n s -> (s -> n s) -> n s
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 s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
padding then String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"padded1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
template) (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Show a => a -> String
show s
s)
                      else s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
padding)
            where padding :: s
padding = Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s) s
template
         parsePadding :: s -> m s
parsePadding s
s = if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
padding
                          then String -> m s
forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (s -> String
forall a. Show a => a -> String
show s
s) m s -> String -> m s
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
Parser.<?> (String
"padded1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
template)
                          else s
s s -> m s -> m s
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ ParserInput m -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
ParserInput m -> m (ParserInput m)
Input.string s
ParserInput m
padding
            where padding :: s
padding = Int -> s -> s
forall m. FactorialMonoid m => Int -> m -> m
Factorial.drop (s -> Int
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 :: Int -> Format m n s s
take Int
n = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = Int -> m (ParserInput m)
forall (m :: * -> *). InputParsing m => Int -> m (ParserInput m)
Input.take Int
n,
   serialize :: s -> n s
serialize = \s
s-> if s -> Int
forall m. Factorial m => m -> Int
Factorial.length s
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"a value of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
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 :: (s -> Bool) -> Format m n s s
takeWhile s -> Bool
pred = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = (ParserInput m -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
Input.takeWhile s -> Bool
ParserInput m -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null ((s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.dropWhile s -> Bool
pred s
s) then s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeWhile" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
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 :: (s -> Bool) -> Format m n s s
takeWhile1 s -> Bool
pred = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = (ParserInput m -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputParsing m =>
(ParserInput m -> Bool) -> m (ParserInput m)
Input.takeWhile1 s -> Bool
ParserInput m -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if Bool -> Bool
not (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
s) Bool -> Bool -> Bool
&& s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null ((s -> Bool) -> s -> s
forall m. FactorialMonoid m => (m -> Bool) -> m -> m
Factorial.dropWhile s -> Bool
pred s
s) then s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeWhile1" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
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 :: (Char -> Bool) -> Format m n s s
takeCharsWhile Char -> Bool
pred = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = (Char -> Bool) -> m (ParserInput m)
forall (m :: * -> *).
InputCharParsing m =>
(Char -> Bool) -> m (ParserInput m)
Input.takeCharsWhile Char -> Bool
pred,
   serialize :: s -> n s
serialize = \s
s-> if s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null (Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.dropWhile_ Bool
False Char -> Bool
pred s
s) then s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeCharsWhile" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
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 :: (Char -> Bool) -> Format m n s s
takeCharsWhile1 Char -> Bool
pred = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m s
parse = (Char -> Bool) -> m (ParserInput m)
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 (s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null s
s) Bool -> Bool -> Bool
&& s -> Bool
forall m. MonoidNull m => m -> Bool
Null.null (Bool -> (Char -> Bool) -> s -> s
forall t. TextualMonoid t => Bool -> (Char -> Bool) -> t -> t
Textual.dropWhile_ Bool
False Char -> Bool
pred s
s) then s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
                    else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"takeCharsWhile1" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ s -> String
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 :: Format m n s a -> a -> Format m n s ()
value Format m n s a
f a
v = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m ()
parse = m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x-> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v then a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x else String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (a -> String
forall a. Show a => a -> String
show a
x)),
   serialize :: () -> n s
serialize = \()-> Format m n s a -> a -> n s
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 :: (a -> Bool) -> Format m n s a -> Format m n s a
satisfy a -> Bool
predicate Format m n s a
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v-> if a -> Bool
predicate a
v then a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v else String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (a -> String
forall a. Show a => a -> String
show a
v),
   serialize :: a -> n s
serialize = \a
v-> if a -> Bool
predicate a
v then Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
v else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"satisfy" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ a -> String
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 :: (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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m t a
parse = (s -> t) -> (t -> s) -> m s a -> m t a
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' (Format (m s) n s a -> m s a
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 (s -> t) -> n s -> n t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (n s -> n t) -> (a -> n s) -> a -> n t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format (m s) n s a -> a -> n s
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 :: (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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m t a
parse = (s -> Maybe t) -> (t -> Maybe s) -> m s a -> m t a
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' (Format (m s) n s a -> m s a
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 = (t -> Maybe t -> t
forall a. a -> Maybe a -> a
fromMaybe (String -> t
forall a. HasCallStack => String -> a
error String
"Partial serialization") (Maybe t -> t) -> (s -> Maybe t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe t
f (s -> t) -> n s -> n t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (n s -> n t) -> (a -> n s) -> a -> n t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format (m s) n s a -> a -> n s
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 :: (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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m b
parse = a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format,
   serialize :: b -> n s
serialize = Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format (a -> n s) -> (b -> a) -> b -> n s
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 :: (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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m b
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v-> m b -> (b -> m b) -> Maybe b -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m b
forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected (String -> m b) -> String -> m b
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
f a
v),
   serialize :: b -> n s
serialize = \b
v-> n s -> (a -> n s) -> Maybe a -> n s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
"mapMaybeValue" (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ b -> String
forall a. Show a => a -> String
show b
v)) (Format m n s a -> a -> n s
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 :: Format m n ByteString Word8
byte = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m Word8
parse = ByteString -> Word8
ByteString.head (ByteString -> Word8) -> m ByteString -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). InputParsing m => m (ParserInput m)
Input.anyToken,
   serialize :: Word8 -> n ByteString
serialize = ByteString -> n ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> n ByteString)
-> (Word8 -> ByteString) -> Word8 -> n ByteString
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 :: Format m n s Char
char = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m Char
parse = m Char
forall (m :: * -> *). CharParsing m => m Char
Parser.Char.anyChar,
   serialize :: Char -> n s
serialize = s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> n s) -> (Char -> s) -> Char -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (Char -> String) -> Char -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
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 :: Format m n ByteString a
cereal = Get a -> Putter a -> Format m n ByteString a
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
forall t. Serialize t => Get t
Serialize.get Putter a
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' :: Get a -> Putter a -> Format m n ByteString a
cereal' Get a
get Putter a
put = m a -> (a -> n ByteString) -> Format m n ByteString a
forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format m a
p (ByteString -> n ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> n ByteString)
-> (a -> ByteString) -> a -> n ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> Putter a -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter a
put)
   where p :: m a
p = Result a -> m a
forall (m :: * -> *) a.
(Monad m, InputParsing m, ParserInput m ~ ByteString) =>
Result a -> m a
go (Get a -> ByteString -> Result a
forall a. Get a -> ByteString -> Result a
runGetPartial Get a
get ByteString
forall a. Monoid a => a
mempty)
            where go :: Result a -> m a
go (Fail String
msg ByteString
_) = String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
Parser.unexpected String
msg
                  go (Done a
r ByteString
_) = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
                  go (Partial ByteString -> Result a
cont) = m ByteString
forall (m :: * -> *). InputParsing m => m (ParserInput m)
Input.anyToken m ByteString -> (ByteString -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result a -> m a
go (Result a -> m a) -> (ByteString -> Result a) -> ByteString -> m a
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 :: Int -> Format m n s a -> Format m n s [a]
count Int
n Format m n s a
item = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m [a]
parse = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Parser.count (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Format m n s a -> m a
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 [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then [s] -> s
forall a. Monoid a => [a] -> a
mconcat ([s] -> s) -> n [s] -> n s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> n s) -> [a] -> n [s]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
item) [a]
as
                     else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (String
"a list of length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ [a] -> String
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 :: g (Format m n s) -> Format m n s (g Identity)
record = (forall a. Identity (n a) -> n a)
-> g (Format m n s) -> Format m n s (g Identity)
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
forall a. Identity (n a) -> n 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 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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (g o)
parse = g m -> m (g o)
forall (m :: * -> *) (g :: (* -> *) -> *) (n :: * -> *).
(FixTraversable m, Traversable g, Applicative n) =>
g m -> m (g n)
fixSequence (forall a. Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse (forall a. Format m n s a -> m a) -> g (Format m n s) -> g m
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 = Ap n s -> n s
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap n s -> n s) -> (g o -> Ap n s) -> g o -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Const (Ap n s) a -> Ap n s)
-> g (Const (Ap n s)) -> Ap n s
forall k (g :: (k -> *) -> *) m (p :: k -> *).
(Foldable g, Monoid m) =>
(forall (a :: k). p a -> m) -> g p -> m
Rank2.foldMap forall a. Const (Ap n s) a -> Ap n s
forall a k (b :: k). Const a b -> a
Functor.getConst (g (Const (Ap n s)) -> Ap n s)
-> (g o -> g (Const (Ap n s))) -> g o -> Ap n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Format m n s a -> o a -> Const (Ap n s) a)
-> g (Format m n s) -> g o -> g (Const (Ap n s))
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 :: Format m n s a -> o a -> Const (Ap n s) a
serializeField Format m n s a
format o a
xs = Ap n s -> Const (Ap n s) a
forall k a (b :: k). a -> Const a b
Functor.Const (n s -> Ap n s
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (n s -> Ap n s) -> n s -> Ap n s
forall a b. (a -> b) -> a -> b
$ o (n s) -> n s
forall a. o (n a) -> n a
collapse (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format (a -> n s) -> o a -> o (n s)
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 <$ :: a -> Format m n s () -> Format m n s a
<$ Format m n s ()
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = a
a a -> m () -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ Format m n s () -> m ()
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then Format m n s () -> () -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
f () else String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName (a -> String
forall a. Show a => a -> String
show a
a) (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure (String -> n s) -> String -> n s
forall a b. (a -> b) -> a -> b
$ a -> String
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 *> :: Format m n s () -> Format m n s a -> Format m n s a
*> Format m n s a
f2 = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = Format m n s () -> m ()
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
f1 m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
Applicative.*> Format m n s a -> m a
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-> (s -> s -> s) -> n s -> n s -> n s
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>) (Format m n s () -> () -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
f1 ()) (Format m n s a -> a -> n s
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 <* :: Format m n s a -> Format m n s () -> Format m n s a
<* Format m n s ()
f2 = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
Applicative.<* Format m n s () -> m ()
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-> (s -> s -> s) -> n s -> n s -> n s
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>) (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1 a
a) (Format m n s () -> () -> n s
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 <|> :: Format m n s a -> Format m n s a -> Format m n s a
<|> Format m n s a
f2 = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> Format m n s a -> m a
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-> Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1 a
a n s -> n s -> n s
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> Format m n s a -> a -> n s
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 <+> :: Format m n s a -> Format m n s b -> Format m n s (Either a b)
<+> Format m n s b
f2 = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (Either a b)
parse = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f1 m (Either a b) -> m (Either a b) -> m (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format m n s b -> m 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 = (a -> n s) -> (b -> n s) -> Either a b -> n s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f1) (Format m n s b -> b -> n s
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 :: Format m n s a -> Format m n s (Maybe a)
optional Format m n s a
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (Maybe a)
parse = m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Applicative.optional (Format m n s a -> m a
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 = n s -> (a -> n s) -> Maybe a -> n s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> n s
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
forall a. Monoid a => a
mempty) (Format m n s a -> a -> n s
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 :: 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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (Maybe a)
parse = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
Applicative.<|> Maybe a
forall a. Maybe a
Nothing Maybe a -> m () -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
Applicative.<$ Format m n s () -> m ()
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s ()
d,
   serialize :: Maybe a -> n s
serialize = n s -> (a -> n s) -> Maybe a -> n s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Format m n s () -> () -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
d ()) (Format m n s a -> a -> n s
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 :: Format m n s a -> Format m n s [a]
many Format m n s a
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m [a]
parse = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many (Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f),
   serialize :: [a] -> n s
serialize = ([s] -> s) -> n [s] -> n s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [s] -> s
forall a. Monoid a => [a] -> a
mconcat (n [s] -> n s) -> ([a] -> n [s]) -> [a] -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> n s) -> [a] -> n [s]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Format m n s a -> a -> n s
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 :: Format m n s a -> Format m n s [a]
some Format m n s a
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m [a]
parse = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.some (Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f),
   serialize :: [a] -> n s
serialize = n s -> (NonEmpty a -> n s) -> Maybe (NonEmpty a) -> n s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a
failure String
"[]") ((NonEmpty s -> s) -> n (NonEmpty s) -> n s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty s -> s
forall a. Semigroup a => NonEmpty a -> a
sconcat (n (NonEmpty s) -> n s)
-> (NonEmpty a -> n (NonEmpty s)) -> NonEmpty a -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> n s) -> NonEmpty a -> n (NonEmpty s)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f)) (Maybe (NonEmpty a) -> n s)
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
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 :: 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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m [a]
parse = m a -> m () -> m [a]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
Parser.sepBy (Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
format) (Format m n s () -> m ()
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-> [s] -> s
forall a. Monoid a => [a] -> a
mconcat ([s] -> s) -> n [s] -> n s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [n s] -> n [s]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (n s -> [n s] -> [n s]
forall a. a -> [a] -> [a]
List.intersperse (Format m n s () -> () -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s ()
separator ()) ([n s] -> [n s]) -> [n s] -> [n s]
forall a b. (a -> b) -> a -> b
$ Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
format (a -> n s) -> [a] -> [n s]
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 :: 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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (a, b)
parse = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Format m n s b -> m 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)-> (s -> s -> s) -> n s -> n s -> n s
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>) (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
a) (Format m n s b -> b -> n s
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 :: 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 :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m (a, b)
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m a -> (a -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a-> Format m n s b -> m b
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse (a -> Format m n s b
g a
a) m b -> (b -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
b-> (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b),
   serialize :: (a, b) -> n s
serialize = \(a
a, b
b)-> (s -> s -> s) -> n s -> n s -> n s
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>) (Format m n s a -> a -> n s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format m n s a
f a
a) (Format m n s b -> b -> n s
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 :: Format m n s a
empty = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = m a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty,
   serialize :: a -> n s
serialize = n s -> a -> n s
forall a b. a -> b -> a
const n s
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 <?> :: Format m n s a -> String -> Format m n s a
<?> String
name = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse Format m n s a
f m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
Parser.<?> String
name,
   serialize :: a -> n s
serialize = String -> n s -> n s
forall (m :: * -> *) a. AlternativeFail m => String -> m a -> m a
expectedName String
name (n s -> n s) -> (a -> n s) -> a -> n s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format m n s a -> a -> n s
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 :: (a -> Format m n s a) -> Format m n s a
mfix a -> Format m n s a
f = Format :: forall (m :: * -> *) (n :: * -> *) s a.
m a -> (a -> n s) -> Format m n s a
Format{
   parse :: m a
parse = (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
Monad.Fix.mfix (Format m n s a -> m a
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> m a
parse (Format m n s a -> m a) -> (a -> Format m n s a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Format m n s a
f),
   serialize :: a -> n s
serialize = \a
a-> Format m n s a -> a -> n s
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 :: 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 = ([(a, s)], Maybe (Maybe (a -> a), Parser Symmetric s a))
-> [(a, s)]
forall a b. (a, b) -> a
fst (([(a, s)], Maybe (Maybe (a -> a), Parser Symmetric s a))
 -> [(a, s)])
-> Either
     String ([(a, s)], Maybe (Maybe (a -> a), Parser Symmetric s a))
-> Either String [(a, s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symmetric s a
-> Either
     String ([(a, s)], Maybe (Maybe (a -> a), Parser Symmetric s a))
forall t s r.
Parser t s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))
Incremental.inspect (Parser Symmetric s a -> Parser Symmetric s a
forall s t r. Monoid s => Parser t s r -> Parser t s r
Incremental.feedEof (Parser Symmetric s a -> Parser Symmetric s a)
-> Parser Symmetric s a -> Parser Symmetric s a
forall a b. (a -> b) -> a -> b
$ s -> Parser Symmetric s a -> Parser Symmetric s a
forall s t r. Monoid s => s -> Parser t s r -> Parser t s r
Incremental.feed s
input (Parser Symmetric s a -> Parser Symmetric s a)
-> Parser Symmetric s a -> Parser Symmetric s a
forall a b. (a -> b) -> a -> b
$ Format (Parser Symmetric s) (Either Error) s a
-> Parser Symmetric s a
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 :: Format (Parser Symmetric s) (Either Error) s a
-> a -> Either String s
testSerialize Format (Parser Symmetric s) (Either Error) s a
format = (Error -> Either String s)
-> (s -> Either String s) -> Either Error s -> Either String s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String s
forall a b. a -> Either a b
Left (String -> Either String s)
-> (Error -> String) -> Error -> Either String s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> String
errorString) s -> Either String s
forall a b. b -> Either a b
Right (Either Error s -> Either String s)
-> (a -> Either Error s) -> a -> Either String s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format (Parser Symmetric s) (Either Error) s a
-> a -> Either Error s
forall (m :: * -> *) (n :: * -> *) s a. Format m n s a -> a -> n s
serialize Format (Parser Symmetric s) (Either Error) s a
format