{-# LANGUAGE CPP #-}
-- | @Unjson@: bidirectional JSON (de)serialization with strong error
-- reporting capabilities and automatic documentation generation.
--
-- @Data.Unjson@ offers:
--
-- * single definition for serialization and deserialization
--
-- * parse and update mode
--
-- * exact error reporting
--
-- * required, optional and fields with default values
--
-- * first class object, array and tuple support
--
-- * lifting of Aeson instances
--
-- * automatic documentation generation
--
-- Example:
--
-- > data Example = Example
-- >    { exampleName     :: Text.Text,
-- >      exampleArray    :: [Int],
-- >      exampleOptional :: Maybe Bool }
-- >
-- > unjsonExample :: UnjsonDef Example
-- > unjsonExample = objectOf $ pure Example
-- >   <*> field "name"
-- >           exampleName
-- >           "Name used for example"
-- >   <*> fieldDefBy "array_of_ints" []
-- >           exampleArray
-- >           "Array of integers, optional, defaults to empty list"
-- >           (arrayOf unjsonDef)
-- >   <*> fieldOpt "optional_bool"
-- >           exampleOptional
-- >           "Optional boolean"
--
-- Rendered documentation:
--
-- > name (req):
-- >     Name used for example
-- >     Text
-- > array_of_ints (def):
-- >     Array of integers, optional, defaults to empty list
-- >     array of:
-- >         Int
-- > optional_bool (opt):
-- >     Optional boolean
-- >     Bool
--
-- Documentation has some colors that could not be reproduced in
-- haddock.
--
-- Parsing:
--
-- > let Result val iss = parse unjsonExample $
-- >                      object [ "name"          .= 123
-- >                             , "array_of_ints" .= [toJSON 123, toJSON "abc"]
-- >                             , "optional_bool" .= True ]
--
-- Error reporting:
--
-- > mapM_ print iss
-- > > name: "when expecting a Text, encountered Number instead"
-- > > array_of_ints[1]: "when expecting a Integral, encountered String instead"
--
-- Partial results:
--
-- > print (exampleOptional val)
-- > > Just True
--
-- Bottom errors in partial results:
--
-- > print (exampleName val)
-- > > "*** Exception: name: "when expecting a Text, encountered Number instead"
--
-- Note: if list of issues is empty then there are not bottoms, guaranteed.
--
-- For more examples have a look at 'Unjson', 'parse', 'update',
-- 'unjsonToJSON', 'unjsonToByteStringLazy',
-- 'unjsonToByteStringBuilder' and 'render'.
module Data.Unjson
  ( -- * Serialization to JSON
    unjsonToJSON
  , unjsonToJSON'
  , unjsonToByteStringLazy
  , unjsonToByteStringLazy'
  , unjsonToByteStringBuilder
  , unjsonToByteStringBuilder'
  , unjsonToByteStringBuilder''
  , Options(..)

  -- * Data definitions
  , Unjson(..)
  , UnjsonDef(..)

  -- ** Objects
  , objectOf
  , field
  , fieldBy
  , fieldOpt
  , fieldOptBy
  , fieldDef
  , fieldDefBy
  , fieldReadonly
  , fieldReadonlyBy
  , FieldDef(..)
  -- ** Arrays
  , arrayOf
  , arrayWithModeOf
  , arrayWithModeOf'
  , arrayWithPrimaryKeyOf
  , arrayWithModeAndPrimaryKeyOf
  , ArrayMode(..)
  -- ** Maps, enums, sums
  , mapOf
  , enumOf
  , enumUnjsonDef
  , disjointUnionOf
  , unionOf
  -- ** Helpers
  , unjsonAeson
  , unjsonAesonWithDoc

  -- * Documentation rendering
  , render
  , renderForPath
  , renderDoc
  , renderDocForPath

  -- * Parsing and updating
  , parse
  , update
  , Result(..)
  , Anchored(..)
  , Problem
  , Problems
  , Path(..)
  , PathElem(..)

  , unjsonInvmapR
  , unjsonIsConstrByName
  , unjsonIPv4AsWord32
  ) where

import Control.Applicative.Free
import Control.Exception
import Control.Monad
import Data.Data
import Data.Fixed
import Data.Functor.Invariant
import Data.Hashable
import Data.Maybe
import Data.Monoid hiding (Ap)
import Data.Primitive.Types
import Data.Scientific
import Data.Time.Clock
import Data.Time.LocalTime
import Foreign.Storable
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as BSL
import qualified Data.HashSet as HashSet
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map as Map
import qualified Data.Semigroup as SG
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic
import qualified Data.Vector.Primitive
import qualified Data.Vector.Storable
import qualified Data.Vector.Unboxed

import Data.Bits
import Data.Char
import Data.Int
import Data.List
import Data.Ratio
import Data.Word
import qualified Data.Unjson.Internal.Aeson.Compat as AC
import qualified Text.ParserCombinators.ReadP as ReadP
import qualified Text.PrettyPrint.HughesPJ as P

#if !MIN_VERSION_aeson(2,0,1)
import qualified Data.HashMap.Strict as HashMap
#endif

-- | Describe a path from root JSON element to a specific
-- position. JSON has only two types of containers: objects and
-- arrays, so there are only two types of keys needed to index into
-- those containers: 'Int' and 'Text.Text'. See 'Path'.
data PathElem = PathElemKey Text.Text
              | PathElemIndex Int
  deriving (Typeable, PathElem -> PathElem -> Bool
(PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> Bool) -> Eq PathElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathElem -> PathElem -> Bool
$c/= :: PathElem -> PathElem -> Bool
== :: PathElem -> PathElem -> Bool
$c== :: PathElem -> PathElem -> Bool
Eq, Eq PathElem
Eq PathElem
-> (PathElem -> PathElem -> Ordering)
-> (PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> Bool)
-> (PathElem -> PathElem -> PathElem)
-> (PathElem -> PathElem -> PathElem)
-> Ord PathElem
PathElem -> PathElem -> Bool
PathElem -> PathElem -> Ordering
PathElem -> PathElem -> PathElem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathElem -> PathElem -> PathElem
$cmin :: PathElem -> PathElem -> PathElem
max :: PathElem -> PathElem -> PathElem
$cmax :: PathElem -> PathElem -> PathElem
>= :: PathElem -> PathElem -> Bool
$c>= :: PathElem -> PathElem -> Bool
> :: PathElem -> PathElem -> Bool
$c> :: PathElem -> PathElem -> Bool
<= :: PathElem -> PathElem -> Bool
$c<= :: PathElem -> PathElem -> Bool
< :: PathElem -> PathElem -> Bool
$c< :: PathElem -> PathElem -> Bool
compare :: PathElem -> PathElem -> Ordering
$ccompare :: PathElem -> PathElem -> Ordering
$cp1Ord :: Eq PathElem
Ord, Int -> PathElem -> ShowS
[PathElem] -> ShowS
PathElem -> String
(Int -> PathElem -> ShowS)
-> (PathElem -> String) -> ([PathElem] -> ShowS) -> Show PathElem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathElem] -> ShowS
$cshowList :: [PathElem] -> ShowS
show :: PathElem -> String
$cshow :: PathElem -> String
showsPrec :: Int -> PathElem -> ShowS
$cshowsPrec :: Int -> PathElem -> ShowS
Show)

-- | 'Path's are rendered in a nice way. For example: @key.key2[34]@
-- indexes into \"key\", then into \"key2\" then into index 34 of an
-- array.
newtype Path = Path [PathElem]
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord, Typeable, b -> Path -> Path
NonEmpty Path -> Path
Path -> Path -> Path
(Path -> Path -> Path)
-> (NonEmpty Path -> Path)
-> (forall b. Integral b => b -> Path -> Path)
-> Semigroup Path
forall b. Integral b => b -> Path -> Path
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Path -> Path
$cstimes :: forall b. Integral b => b -> Path -> Path
sconcat :: NonEmpty Path -> Path
$csconcat :: NonEmpty Path -> Path
<> :: Path -> Path -> Path
$c<> :: Path -> Path -> Path
SG.Semigroup, Semigroup Path
Path
Semigroup Path
-> Path
-> (Path -> Path -> Path)
-> ([Path] -> Path)
-> Monoid Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Path] -> Path
$cmconcat :: [Path] -> Path
mappend :: Path -> Path -> Path
$cmappend :: Path -> Path -> Path
mempty :: Path
$cmempty :: Path
$cp1Monoid :: Semigroup Path
Monoid)

instance Show Path where
  show :: Path -> String
show (Path [PathElem]
p) = Text -> String
Text.unpack (Bool -> [PathElem] -> Text
showPath Bool
True [PathElem]
p)

showPath :: Bool -> [PathElem] -> Text.Text
showPath :: Bool -> [PathElem] -> Text
showPath Bool
_ [] = Text
""
showPath Bool
True (PathElemKey Text
key : [PathElem]
rest) = Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> [PathElem] -> Text
showPath Bool
False [PathElem]
rest
showPath Bool
False (PathElemKey Text
key : [PathElem]
rest) = Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> [PathElem] -> Text
showPath Bool
False [PathElem]
rest
showPath Bool
_ (PathElemIndex Int
key : [PathElem]
rest) = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
key) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> [PathElem] -> Text
showPath Bool
False [PathElem]
rest

-- | A value at a specific position in JSON object.
data Anchored a = Anchored Path a
  deriving (Typeable, a -> Anchored b -> Anchored a
(a -> b) -> Anchored a -> Anchored b
(forall a b. (a -> b) -> Anchored a -> Anchored b)
-> (forall a b. a -> Anchored b -> Anchored a) -> Functor Anchored
forall a b. a -> Anchored b -> Anchored a
forall a b. (a -> b) -> Anchored a -> Anchored b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Anchored b -> Anchored a
$c<$ :: forall a b. a -> Anchored b -> Anchored a
fmap :: (a -> b) -> Anchored a -> Anchored b
$cfmap :: forall a b. (a -> b) -> Anchored a -> Anchored b
Functor, Anchored a -> Anchored a -> Bool
(Anchored a -> Anchored a -> Bool)
-> (Anchored a -> Anchored a -> Bool) -> Eq (Anchored a)
forall a. Eq a => Anchored a -> Anchored a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anchored a -> Anchored a -> Bool
$c/= :: forall a. Eq a => Anchored a -> Anchored a -> Bool
== :: Anchored a -> Anchored a -> Bool
$c== :: forall a. Eq a => Anchored a -> Anchored a -> Bool
Eq, Eq (Anchored a)
Eq (Anchored a)
-> (Anchored a -> Anchored a -> Ordering)
-> (Anchored a -> Anchored a -> Bool)
-> (Anchored a -> Anchored a -> Bool)
-> (Anchored a -> Anchored a -> Bool)
-> (Anchored a -> Anchored a -> Bool)
-> (Anchored a -> Anchored a -> Anchored a)
-> (Anchored a -> Anchored a -> Anchored a)
-> Ord (Anchored a)
Anchored a -> Anchored a -> Bool
Anchored a -> Anchored a -> Ordering
Anchored a -> Anchored a -> Anchored a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Anchored a)
forall a. Ord a => Anchored a -> Anchored a -> Bool
forall a. Ord a => Anchored a -> Anchored a -> Ordering
forall a. Ord a => Anchored a -> Anchored a -> Anchored a
min :: Anchored a -> Anchored a -> Anchored a
$cmin :: forall a. Ord a => Anchored a -> Anchored a -> Anchored a
max :: Anchored a -> Anchored a -> Anchored a
$cmax :: forall a. Ord a => Anchored a -> Anchored a -> Anchored a
>= :: Anchored a -> Anchored a -> Bool
$c>= :: forall a. Ord a => Anchored a -> Anchored a -> Bool
> :: Anchored a -> Anchored a -> Bool
$c> :: forall a. Ord a => Anchored a -> Anchored a -> Bool
<= :: Anchored a -> Anchored a -> Bool
$c<= :: forall a. Ord a => Anchored a -> Anchored a -> Bool
< :: Anchored a -> Anchored a -> Bool
$c< :: forall a. Ord a => Anchored a -> Anchored a -> Bool
compare :: Anchored a -> Anchored a -> Ordering
$ccompare :: forall a. Ord a => Anchored a -> Anchored a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Anchored a)
Ord)

instance (Show a) => Show (Anchored a) where
  show :: Anchored a -> String
show (Anchored (Path [PathElem]
path) a
value) = Text -> String
Text.unpack (Bool -> [PathElem] -> Text
showPath Bool
True [PathElem]
path) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
value

instance (Typeable a, Show a) => Exception (Anchored a)

-- | Problem information is represented as a 'Text.Text' attached to a
-- specific point in the JSON represenation tree.
type Problem = Anchored Text.Text

-- | In general JSON deserialization may result in many
-- problems. Unjson reports all the problems at once.
type Problems = [Problem]

-- | Parsing result. The value 'a' is only reliable when 'Problems' is
-- an empty list.
--
-- 'Problems' is list of issues encountered while parsing. 'Unjson'
-- parsers continue forward and are able to find many problems at
-- once.
--
-- Note that problems are anchored to specific elements of JSON so it
-- should be easy to find and spot an error.
--
-- Even if list of problems is not empty, the returned value may be
-- partially usable.
--
-- Examples of list of problems:
--
-- > [Anchored [PathElemKey "credentials",PathElemKey "password"] "missing key",
-- >  Anchored [PathElemKey "tuple"] "cannot parse array of length 3 into tuple of size 4",
-- >  Anchored [PathElemKey "text_array",PathElemIndex 0.PathElemKey "value"]
-- >                                  "when expecting a Text, encountered Boolean instead"]
--
-- conveniently rendered as:
--
-- > "credentials.password": "missing key"
-- > "tuple": "cannot parse array of length 3 into tuple of size 4"
-- > "text_array[0].value": "when expecting a Text, encountered Boolean instead"

data Result a = Result a Problems
  deriving (a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor, Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, Eq (Result a)
Eq (Result a)
-> (Result a -> Result a -> Ordering)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Result a)
-> (Result a -> Result a -> Result a)
-> Ord (Result a)
Result a -> Result a -> Bool
Result a -> Result a -> Ordering
Result a -> Result a -> Result a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Result a)
forall a. Ord a => Result a -> Result a -> Bool
forall a. Ord a => Result a -> Result a -> Ordering
forall a. Ord a => Result a -> Result a -> Result a
min :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
>= :: Result a -> Result a -> Bool
$c>= :: forall a. Ord a => Result a -> Result a -> Bool
> :: Result a -> Result a -> Bool
$c> :: forall a. Ord a => Result a -> Result a -> Bool
<= :: Result a -> Result a -> Bool
$c<= :: forall a. Ord a => Result a -> Result a -> Bool
< :: Result a -> Result a -> Bool
$c< :: forall a. Ord a => Result a -> Result a -> Bool
compare :: Result a -> Result a -> Ordering
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Result a)
Ord, Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq)

instance Applicative Result where
  pure :: a -> Result a
pure a
a = a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
a []
  Result a -> b
a Problems
pa <*> :: Result (a -> b) -> Result a -> Result b
<*> Result a
b Problems
pb = b -> Problems -> Result b
forall a. a -> Problems -> Result a
Result (a -> b
a a
b) (Problems
pa Problems -> Problems -> Problems
forall a. [a] -> [a] -> [a]
++ Problems
pb)

instance Monad Result where
  return :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Result a
a [] >>= :: Result a -> (a -> Result b) -> Result b
>>= a -> Result b
m = a -> Result b
m a
a
  Result a
_ es :: Problems
es@(Problem
e:Problems
_) >>= a -> Result b
_ = b -> Problems -> Result b
forall a. a -> Problems -> Result a
Result (Problem -> b
forall a e. Exception e => e -> a
throw Problem
e) Problems
es

instance MonadFail Result where
  fail :: String -> Result a
fail String
str = a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result (Problem -> a
forall a e. Exception e => e -> a
throw Problem
anchoredMessage) [Problem
anchoredMessage]
    where anchoredMessage :: Problem
anchoredMessage = Path -> Text -> Problem
forall a. Path -> a -> Anchored a
Anchored Path
forall a. Monoid a => a
mempty (String -> Text
Text.pack String
str)

-- | 'Unjson' typeclass describes all types that can be parsed from
-- JSON and JSON generated from their values.
--
-- Example declaration:
--
-- > instance Unjson Thing where
-- >     unjsonDef = objectOf $ pure Thing
-- >         <*> field "key1"
-- >               thingField1
-- >               "Required field of type with Unjson instance"
-- >         <*> fieldBy "key2"
-- >               thingField2
-- >               "Required field with parser given below"
-- >               unjsonForKey2
-- >         <*> fieldOpt "key4"
-- >               thingField4
-- >               "Optional field of type with Unjson instance"
-- >         <*> fieldOptBy "key5"
-- >               thingField5
-- >               "Optional field with parser given below"
-- >               unjsonForKey5
-- >         <*> fieldDef "key7"
-- >               thingField7
-- >               "Optional field with default of type with Unjson instance"
-- >         <*> fieldDefBy "key8"
-- >               thingField8
-- >               "Optional field with default with parser given below"
-- >               unjsonForKey8
class Unjson a where
  -- | Definition of a bidirectional parser for a type 'a'. See
  -- 'parse', 'update', 'serialize' and 'render' to see how to use
  -- 'UnjsonDef'.
  unjsonDef :: UnjsonDef a

instance {-# OVERLAPPABLE #-} (Unjson a, Typeable a) => Unjson [a] where
  unjsonDef :: UnjsonDef [a]
unjsonDef = UnjsonDef a -> UnjsonDef [a]
forall a. Typeable a => UnjsonDef a -> UnjsonDef [a]
arrayOf UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef

instance Unjson String where
  unjsonDef :: UnjsonDef String
unjsonDef = Text -> UnjsonDef String
forall a. (FromJSON a, ToJSON a) => Text -> UnjsonDef a
unjsonAesonWithDoc Text
"String"

instance Unjson Bool             where unjsonDef :: UnjsonDef Bool
unjsonDef = UnjsonDef Bool
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Char             where unjsonDef :: UnjsonDef Char
unjsonDef = UnjsonDef Char
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Double           where unjsonDef :: UnjsonDef Double
unjsonDef = UnjsonDef Double
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Float            where unjsonDef :: UnjsonDef Float
unjsonDef = UnjsonDef Float
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Int              where unjsonDef :: UnjsonDef Int
unjsonDef = UnjsonDef Int
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Int8             where unjsonDef :: UnjsonDef Int8
unjsonDef = UnjsonDef Int8
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Int16            where unjsonDef :: UnjsonDef Int16
unjsonDef = UnjsonDef Int16
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Int32            where unjsonDef :: UnjsonDef Int32
unjsonDef = UnjsonDef Int32
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Int64            where unjsonDef :: UnjsonDef Int64
unjsonDef = UnjsonDef Int64
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Integer          where unjsonDef :: UnjsonDef Integer
unjsonDef = UnjsonDef Integer
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Word             where unjsonDef :: UnjsonDef Word
unjsonDef = UnjsonDef Word
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Word8            where unjsonDef :: UnjsonDef Word8
unjsonDef = UnjsonDef Word8
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Word16           where unjsonDef :: UnjsonDef Word16
unjsonDef = UnjsonDef Word16
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Word32           where unjsonDef :: UnjsonDef Word32
unjsonDef = UnjsonDef Word32
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Word64           where unjsonDef :: UnjsonDef Word64
unjsonDef = UnjsonDef Word64
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson ()               where unjsonDef :: UnjsonDef ()
unjsonDef = UnjsonDef ()
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Text.Text        where unjsonDef :: UnjsonDef Text
unjsonDef = UnjsonDef Text
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson IntSet.IntSet    where unjsonDef :: UnjsonDef IntSet
unjsonDef = UnjsonDef IntSet
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Scientific       where unjsonDef :: UnjsonDef Scientific
unjsonDef = UnjsonDef Scientific
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson LazyText.Text    where unjsonDef :: UnjsonDef Text
unjsonDef = UnjsonDef Text
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson ZonedTime        where unjsonDef :: UnjsonDef ZonedTime
unjsonDef = UnjsonDef ZonedTime
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson UTCTime          where unjsonDef :: UnjsonDef UTCTime
unjsonDef = UnjsonDef UTCTime
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Aeson.DotNetTime where unjsonDef :: UnjsonDef DotNetTime
unjsonDef = UnjsonDef DotNetTime
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson Aeson.Value      where unjsonDef :: UnjsonDef Value
unjsonDef = UnjsonDef Value
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson (Ratio Integer)  where unjsonDef :: UnjsonDef (Ratio Integer)
unjsonDef = UnjsonDef (Ratio Integer)
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance (HasResolution a, Typeable a, Aeson.FromJSON a, Aeson.ToJSON a) => Unjson (Fixed a) where unjsonDef :: UnjsonDef (Fixed a)
unjsonDef = UnjsonDef (Fixed a)
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson
instance Unjson a => Unjson (Dual a)  where unjsonDef :: UnjsonDef (Dual a)
unjsonDef = (a -> Dual a) -> (Dual a -> a) -> UnjsonDef a -> UnjsonDef (Dual a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> Dual a
forall a. a -> Dual a
Dual Dual a -> a
forall a. Dual a -> a
getDual UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef
{-

-- these work only when 'Maybe a' and 'a' instances are conflated. we do not want this really, do we?
-- First and Last are Monoids here, not sure if/how Unjson should be a monoid or something
instance Unjson a => Unjson (First a)  where unjsonDef = invmap First getFirst unjsonDef
instance Unjson a => Unjson (Last a)  where unjsonDef = unjsonAeson

-- Tree instance creates array of the form ["rootname", [trees]]. We could parse this nicely.
instance Unjson v => Unjson (Tree v)  where unjsonDef = unjsonAeson

-- disjoint unions require special setup
instance (Unjson a, Unjson b) => Unjson (Either a b)  where unjsonDef = unjsonAeson
-}

instance (Unjson a, Typeable a) => Unjson (IntMap.IntMap a)
  where unjsonDef :: UnjsonDef (IntMap a)
unjsonDef = ([(Int, a)] -> IntMap a)
-> (IntMap a -> [(Int, a)])
-> UnjsonDef [(Int, a)]
-> UnjsonDef (IntMap a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList UnjsonDef [(Int, a)]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Ord a, Unjson a, Typeable a) => Unjson (Set.Set a)
  where unjsonDef :: UnjsonDef (Set a)
unjsonDef = ([a] -> Set a)
-> (Set a -> [a]) -> UnjsonDef [a] -> UnjsonDef (Set a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList Set a -> [a]
forall a. Set a -> [a]
Set.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Eq a, Hashable a, Unjson a, Typeable a) => Unjson (HashSet.HashSet a)
  where unjsonDef :: UnjsonDef (HashSet a)
unjsonDef = ([a] -> HashSet a)
-> (HashSet a -> [a]) -> UnjsonDef [a] -> UnjsonDef (HashSet a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList HashSet a -> [a]
forall a. HashSet a -> [a]
HashSet.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Unjson a, Typeable a) => Unjson (Vector.Vector a)
  where unjsonDef :: UnjsonDef (Vector a)
unjsonDef = ([a] -> Vector a)
-> (Vector a -> [a]) -> UnjsonDef [a] -> UnjsonDef (Vector a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Data.Vector.Generic.Vector Data.Vector.Unboxed.Vector a, Unjson a, Data.Vector.Unboxed.Unbox a, Typeable a) => Unjson (Data.Vector.Unboxed.Vector a)
  where unjsonDef :: UnjsonDef (Vector a)
unjsonDef = ([a] -> Vector a)
-> (Vector a -> [a]) -> UnjsonDef [a] -> UnjsonDef (Vector a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> Vector a
forall a. Unbox a => [a] -> Vector a
Data.Vector.Unboxed.fromList Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
Data.Vector.Unboxed.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Storable a, Unjson a, Typeable a) => Unjson (Data.Vector.Storable.Vector a)
  where unjsonDef :: UnjsonDef (Vector a)
unjsonDef = ([a] -> Vector a)
-> (Vector a -> [a]) -> UnjsonDef [a] -> UnjsonDef (Vector a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> Vector a
forall a. Storable a => [a] -> Vector a
Data.Vector.Storable.fromList Vector a -> [a]
forall a. Storable a => Vector a -> [a]
Data.Vector.Storable.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Prim a, Unjson a, Typeable a) => Unjson (Data.Vector.Primitive.Vector a)
  where unjsonDef :: UnjsonDef (Vector a)
unjsonDef = ([a] -> Vector a)
-> (Vector a -> [a]) -> UnjsonDef [a] -> UnjsonDef (Vector a)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap [a] -> Vector a
forall a. Prim a => [a] -> Vector a
Data.Vector.Primitive.fromList Vector a -> [a]
forall a. Prim a => Vector a -> [a]
Data.Vector.Primitive.toList UnjsonDef [a]
forall a. Unjson a => UnjsonDef a
unjsonDef


mapFst :: (a -> c) -> (a,b) -> (c,b)
mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst a -> c
f (a
a,b
b) = (a -> c
f a
a, b
b)

instance (Typeable v, Unjson v) => Unjson (Map.Map String v)
  where unjsonDef :: UnjsonDef (Map String v)
unjsonDef = (KeyMap v -> Map String v)
-> (Map String v -> KeyMap v)
-> UnjsonDef (KeyMap v)
-> UnjsonDef (Map String v)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap ([(String, v)] -> Map String v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, v)] -> Map String v)
-> (KeyMap v -> [(String, v)]) -> KeyMap v -> Map String v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, v) -> (String, v)) -> [(Key, v)] -> [(String, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> String) -> (Key, v) -> (String, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Key -> String
AC.toString) ([(Key, v)] -> [(String, v)])
-> (KeyMap v -> [(Key, v)]) -> KeyMap v -> [(String, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
AC.toList)
                                     ([(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
AC.fromList ([(Key, v)] -> KeyMap v)
-> (Map String v -> [(Key, v)]) -> Map String v -> KeyMap v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, v) -> (Key, v)) -> [(String, v)] -> [(Key, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Key) -> (String, v) -> (Key, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst String -> Key
AC.fromString) ([(String, v)] -> [(Key, v)])
-> (Map String v -> [(String, v)]) -> Map String v -> [(Key, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String v -> [(String, v)]
forall k a. Map k a -> [(k, a)]
Map.toList)
                                     UnjsonDef (KeyMap v)
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Typeable v, Unjson v) => Unjson (Map.Map Text.Text v)
  where unjsonDef :: UnjsonDef (Map Text v)
unjsonDef = (KeyMap v -> Map Text v)
-> (Map Text v -> KeyMap v)
-> UnjsonDef (KeyMap v)
-> UnjsonDef (Map Text v)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap ([(Text, v)] -> Map Text v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, v)] -> Map Text v)
-> (KeyMap v -> [(Text, v)]) -> KeyMap v -> Map Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, v) -> (Text, v)) -> [(Key, v)] -> [(Text, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Text) -> (Key, v) -> (Text, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Key -> Text
AC.toText) ([(Key, v)] -> [(Text, v)])
-> (KeyMap v -> [(Key, v)]) -> KeyMap v -> [(Text, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
AC.toList)
                                     ([(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
AC.fromList ([(Key, v)] -> KeyMap v)
-> (Map Text v -> [(Key, v)]) -> Map Text v -> KeyMap v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, v) -> (Key, v)) -> [(Text, v)] -> [(Key, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Key) -> (Text, v) -> (Key, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Text -> Key
AC.fromText) ([(Text, v)] -> [(Key, v)])
-> (Map Text v -> [(Text, v)]) -> Map Text v -> [(Key, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text v -> [(Text, v)]
forall k a. Map k a -> [(k, a)]
Map.toList)
                                     UnjsonDef (KeyMap v)
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Typeable v, Unjson v) => Unjson (Map.Map LazyText.Text v)
  where unjsonDef :: UnjsonDef (Map Text v)
unjsonDef = (KeyMap v -> Map Text v)
-> (Map Text v -> KeyMap v)
-> UnjsonDef (KeyMap v)
-> UnjsonDef (Map Text v)
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap ([(Text, v)] -> Map Text v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, v)] -> Map Text v)
-> (KeyMap v -> [(Text, v)]) -> KeyMap v -> Map Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, v) -> (Text, v)) -> [(Key, v)] -> [(Text, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Text) -> (Key, v) -> (Text, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Text -> Text
LazyText.fromStrict (Text -> Text) -> (Key -> Text) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
AC.toText)) ([(Key, v)] -> [(Text, v)])
-> (KeyMap v -> [(Key, v)]) -> KeyMap v -> [(Text, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
AC.toList)
                                     ([(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
AC.fromList ([(Key, v)] -> KeyMap v)
-> (Map Text v -> [(Key, v)]) -> Map Text v -> KeyMap v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, v) -> (Key, v)) -> [(Text, v)] -> [(Key, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key) -> (Text, v) -> (Key, v)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Text -> Key
AC.fromText (Text -> Key) -> (Text -> Text) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict)) ([(Text, v)] -> [(Key, v)])
-> (Map Text v -> [(Text, v)]) -> Map Text v -> [(Key, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text v -> [(Text, v)]
forall k a. Map k a -> [(k, a)]
Map.toList)
                                     UnjsonDef (KeyMap v)
forall a. Unjson a => UnjsonDef a
unjsonDef
instance (Typeable v, Unjson v) => Unjson (AC.KeyMap v)
  where unjsonDef :: UnjsonDef (KeyMap v)
unjsonDef = UnjsonDef v
-> (KeyMap v -> Result (KeyMap v))
-> (KeyMap v -> KeyMap v)
-> UnjsonDef (KeyMap v)
forall k v.
Typeable k =>
UnjsonDef k
-> (KeyMap k -> Result v) -> (v -> KeyMap k) -> UnjsonDef v
MapUnjsonDef UnjsonDef v
forall a. Unjson a => UnjsonDef a
unjsonDef KeyMap v -> Result (KeyMap v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap v -> KeyMap v
forall a. a -> a
id

#if !MIN_VERSION_aeson(2,0,1)
instance (Typeable v, Unjson v) => Unjson (HashMap.HashMap String v)
  where unjsonDef = invmap (HashMap.fromList . map (mapFst Text.unpack) . HashMap.toList)
                                     (HashMap.fromList . map (mapFst Text.pack) . HashMap.toList)
                                     unjsonDef
instance (Typeable v, Unjson v) => Unjson (HashMap.HashMap LazyText.Text v)
  where unjsonDef = invmap (HashMap.fromList . map (mapFst LazyText.fromStrict) . HashMap.toList)
                                     (HashMap.fromList . map (mapFst LazyText.toStrict) . HashMap.toList)
                                     unjsonDef
#endif

instance (Unjson a,Unjson b) => Unjson (a,b) where
  unjsonDef :: UnjsonDef (a, b)
unjsonDef = Ap (TupleFieldDef (a, b)) (Result (a, b)) -> UnjsonDef (a, b)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap (TupleFieldDef (a, b)) (Result (a, b)) -> UnjsonDef (a, b))
-> Ap (TupleFieldDef (a, b)) (Result (a, b)) -> UnjsonDef (a, b)
forall a b. (a -> b) -> a -> b
$ ((a, b) -> Result (a, b))
-> Ap (TupleFieldDef (a, b)) (a, b)
-> Ap (TupleFieldDef (a, b)) (Result (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> Result (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                 (Ap (TupleFieldDef (a, b)) (a, b)
 -> Ap (TupleFieldDef (a, b)) (Result (a, b)))
-> Ap (TupleFieldDef (a, b)) (a, b)
-> Ap (TupleFieldDef (a, b)) (Result (a, b))
forall a b. (a -> b) -> a -> b
$ (a -> b -> (a, b)) -> Ap (TupleFieldDef (a, b)) (a -> b -> (a, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,)
               Ap (TupleFieldDef (a, b)) (a -> b -> (a, b))
-> Ap (TupleFieldDef (a, b)) a
-> Ap (TupleFieldDef (a, b)) (b -> (a, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b) a -> Ap (TupleFieldDef (a, b)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int -> ((a, b) -> a) -> UnjsonDef a -> TupleFieldDef (a, b) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b)) (b -> (a, b))
-> Ap (TupleFieldDef (a, b)) b -> Ap (TupleFieldDef (a, b)) (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b) b -> Ap (TupleFieldDef (a, b)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int -> ((a, b) -> b) -> UnjsonDef b -> TupleFieldDef (a, b) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c) => Unjson (a,b,c) where
  unjsonDef :: UnjsonDef (a, b, c)
unjsonDef = Ap (TupleFieldDef (a, b, c)) (Result (a, b, c))
-> UnjsonDef (a, b, c)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap (TupleFieldDef (a, b, c)) (Result (a, b, c))
 -> UnjsonDef (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) (Result (a, b, c))
-> UnjsonDef (a, b, c)
forall a b. (a -> b) -> a -> b
$ ((a, b, c) -> Result (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) (a, b, c)
-> Ap (TupleFieldDef (a, b, c)) (Result (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c) -> Result (a, b, c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap (TupleFieldDef (a, b, c)) (a, b, c)
 -> Ap (TupleFieldDef (a, b, c)) (Result (a, b, c)))
-> Ap (TupleFieldDef (a, b, c)) (a, b, c)
-> Ap (TupleFieldDef (a, b, c)) (Result (a, b, c))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) (a -> b -> c -> (a, b, c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,)
               Ap (TupleFieldDef (a, b, c)) (a -> b -> c -> (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) a
-> Ap (TupleFieldDef (a, b, c)) (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c) a -> Ap (TupleFieldDef (a, b, c)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int -> ((a, b, c) -> a) -> UnjsonDef a -> TupleFieldDef (a, b, c) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c)) (b -> c -> (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) b
-> Ap (TupleFieldDef (a, b, c)) (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c) b -> Ap (TupleFieldDef (a, b, c)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int -> ((a, b, c) -> b) -> UnjsonDef b -> TupleFieldDef (a, b, c) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c)) (c -> (a, b, c))
-> Ap (TupleFieldDef (a, b, c)) c
-> Ap (TupleFieldDef (a, b, c)) (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c) c -> Ap (TupleFieldDef (a, b, c)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int -> ((a, b, c) -> c) -> UnjsonDef c -> TupleFieldDef (a, b, c) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d) => Unjson (a,b,c,d) where
  unjsonDef :: UnjsonDef (a, b, c, d)
unjsonDef = Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d))
-> UnjsonDef (a, b, c, d)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d))
 -> UnjsonDef (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d))
-> UnjsonDef (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d) -> Result (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) (a, b, c, d)
-> Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d) -> Result (a, b, c, d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap (TupleFieldDef (a, b, c, d)) (a, b, c, d)
 -> Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d)))
-> Ap (TupleFieldDef (a, b, c, d)) (a, b, c, d)
-> Ap (TupleFieldDef (a, b, c, d)) (Result (a, b, c, d))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> (a, b, c, d))
-> Ap
     (TupleFieldDef (a, b, c, d)) (a -> b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,)
               Ap (TupleFieldDef (a, b, c, d)) (a -> b -> c -> d -> (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) a
-> Ap (TupleFieldDef (a, b, c, d)) (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d) a -> Ap (TupleFieldDef (a, b, c, d)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d)) (b -> c -> d -> (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) b
-> Ap (TupleFieldDef (a, b, c, d)) (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d) b -> Ap (TupleFieldDef (a, b, c, d)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d)) (c -> d -> (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) c
-> Ap (TupleFieldDef (a, b, c, d)) (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d) c -> Ap (TupleFieldDef (a, b, c, d)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d)) (d -> (a, b, c, d))
-> Ap (TupleFieldDef (a, b, c, d)) d
-> Ap (TupleFieldDef (a, b, c, d)) (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d) d -> Ap (TupleFieldDef (a, b, c, d)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e) => Unjson (a,b,c,d
                              ,e) where
  unjsonDef :: UnjsonDef (a, b, c, d, e)
unjsonDef = Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e))
-> UnjsonDef (a, b, c, d, e)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e))
 -> UnjsonDef (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e))
-> UnjsonDef (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e) -> Result (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) (a, b, c, d, e)
-> Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e) -> Result (a, b, c, d, e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap (TupleFieldDef (a, b, c, d, e)) (a, b, c, d, e)
 -> Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e)))
-> Ap (TupleFieldDef (a, b, c, d, e)) (a, b, c, d, e)
-> Ap (TupleFieldDef (a, b, c, d, e)) (Result (a, b, c, d, e))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Ap
     (TupleFieldDef (a, b, c, d, e))
     (a -> b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e))
  (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e))
     (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e) a
-> Ap (TupleFieldDef (a, b, c, d, e)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e))
  (b -> c -> d -> e -> (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e)) (c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e) b
-> Ap (TupleFieldDef (a, b, c, d, e)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d, e)) (c -> d -> e -> (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) c
-> Ap (TupleFieldDef (a, b, c, d, e)) (d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e) c
-> Ap (TupleFieldDef (a, b, c, d, e)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d, e)) (d -> e -> (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) d
-> Ap (TupleFieldDef (a, b, c, d, e)) (e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e) d
-> Ap (TupleFieldDef (a, b, c, d, e)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d, e)) (e -> (a, b, c, d, e))
-> Ap (TupleFieldDef (a, b, c, d, e)) e
-> Ap (TupleFieldDef (a, b, c, d, e)) (a, b, c, d, e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e) e
-> Ap (TupleFieldDef (a, b, c, d, e)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f)
       => Unjson (a,b,c,d
                 ,e,f) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f)
unjsonDef = Ap (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f))
-> UnjsonDef (a, b, c, d, e, f)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f))
 -> UnjsonDef (a, b, c, d, e, f))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f))
-> UnjsonDef (a, b, c, d, e, f)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f) -> Result (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) (a, b, c, d, e, f)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f) -> Result (a, b, c, d, e, f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap (TupleFieldDef (a, b, c, d, e, f)) (a, b, c, d, e, f)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f)))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) (a, b, c, d, e, f)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f)) (Result (a, b, c, d, e, f))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f))
     (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f))
  (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f))
     (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) a
-> Ap (TupleFieldDef (a, b, c, d, e, f)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f))
  (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f))
     (c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) b
-> Ap (TupleFieldDef (a, b, c, d, e, f)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f))
  (c -> d -> e -> f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f))
     (d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) c
-> Ap (TupleFieldDef (a, b, c, d, e, f)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f))
  (d -> e -> f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f)) (e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) d
-> Ap (TupleFieldDef (a, b, c, d, e, f)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f)) (e -> f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) e
-> Ap (TupleFieldDef (a, b, c, d, e, f)) (f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) e
-> Ap (TupleFieldDef (a, b, c, d, e, f)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap (TupleFieldDef (a, b, c, d, e, f)) (f -> (a, b, c, d, e, f))
-> Ap (TupleFieldDef (a, b, c, d, e, f)) f
-> Ap (TupleFieldDef (a, b, c, d, e, f)) (a, b, c, d, e, f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f) f
-> Ap (TupleFieldDef (a, b, c, d, e, f)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g)
       => Unjson (a,b,c,d
                 ,e,f,g) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (Result (a, b, c, d, e, f, g))
-> UnjsonDef (a, b, c, d, e, f, g)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g))
   (Result (a, b, c, d, e, f, g))
 -> UnjsonDef (a, b, c, d, e, f, g))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (Result (a, b, c, d, e, f, g))
-> UnjsonDef (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g) -> Result (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (Result (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g) -> Result (a, b, c, d, e, f, g)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap (TupleFieldDef (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g))
      (Result (a, b, c, d, e, f, g)))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (Result (a, b, c, d, e, f, g))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (e -> f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g))
     (f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g))
  (f -> g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g)) (g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g)) (g -> (a, b, c, d, e, f, g))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g,Unjson h)
       => Unjson (a,b,c,d
                 ,e,f,g,h) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g, h)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (Result (a, b, c, d, e, f, g, h))
-> UnjsonDef (a, b, c, d, e, f, g, h)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h))
   (Result (a, b, c, d, e, f, g, h))
 -> UnjsonDef (a, b, c, d, e, f, g, h))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (Result (a, b, c, d, e, f, g, h))
-> UnjsonDef (a, b, c, d, e, f, g, h)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g, h) -> Result (a, b, c, d, e, f, g, h))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h)) (a, b, c, d, e, f, g, h)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (Result (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g, h) -> Result (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h)) (a, b, c, d, e, f, g, h)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g, h))
      (Result (a, b, c, d, e, f, g, h)))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h)) (a, b, c, d, e, f, g, h)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (Result (a, b, c, d, e, f, g, h))
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g, h) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_,h
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g, h) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_,h
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g, h) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_,h
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g, h) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_,h
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g, h) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_,h
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g, h) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_,h
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (g -> h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) g
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h))
     (h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g, h) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p,h
_) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h))
  (h -> (a, b, c, d, e, f, g, h))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) h
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h)) (a, b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h) h
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h)) h
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h) -> h)
-> UnjsonDef h
-> TupleFieldDef (a, b, c, d, e, f, g, h) h
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
7 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
p) -> h
p) UnjsonDef h
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g,Unjson h
         ,Unjson i)
       => Unjson (a,b,c,d
                 ,e,f,g,h
                 ,i) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g, h, i)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (Result (a, b, c, d, e, f, g, h, i))
-> UnjsonDef (a, b, c, d, e, f, g, h, i)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i))
   (Result (a, b, c, d, e, f, g, h, i))
 -> UnjsonDef (a, b, c, d, e, f, g, h, i))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (Result (a, b, c, d, e, f, g, h, i))
-> UnjsonDef (a, b, c, d, e, f, g, h, i)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g, h, i) -> Result (a, b, c, d, e, f, g, h, i))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (a, b, c, d, e, f, g, h, i)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (Result (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g, h, i) -> Result (a, b, c, d, e, f, g, h, i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i))
   (a, b, c, d, e, f, g, h, i)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g, h, i))
      (Result (a, b, c, d, e, f, g, h, i)))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (a, b, c, d, e, f, g, h, i)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (Result (a, b, c, d, e, f, g, h, i))
forall a b. (a -> b) -> a -> b
$ (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (a
      -> b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (a
   -> b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (b
      -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (b
   -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_,h
_,i
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_,h
_,i
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_,h
_,i
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_,h
_,i
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_,h
_,i
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) g
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p,h
_,i
_) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (h -> i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) h
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) h
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) h
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> h)
-> UnjsonDef h
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) h
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
7 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
p,i
_) -> h
p) UnjsonDef h
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i))
  (i -> (a, b, c, d, e, f, g, h, i))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) i
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i))
     (a, b, c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i) i
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i)) i
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i) -> i)
-> UnjsonDef i
-> TupleFieldDef (a, b, c, d, e, f, g, h, i) i
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
8 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
p) -> i
p) UnjsonDef i
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g,Unjson h
         ,Unjson i,Unjson j)
       => Unjson (a,b,c,d
                 ,e,f,g,h
                 ,i,j) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g, h, i, j)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (Result (a, b, c, d, e, f, g, h, i, j))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
   (Result (a, b, c, d, e, f, g, h, i, j))
 -> UnjsonDef (a, b, c, d, e, f, g, h, i, j))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (Result (a, b, c, d, e, f, g, h, i, j))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g, h, i, j)
 -> Result (a, b, c, d, e, f, g, h, i, j))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (a, b, c, d, e, f, g, h, i, j)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (Result (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g, h, i, j)
-> Result (a, b, c, d, e, f, g, h, i, j)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
   (a, b, c, d, e, f, g, h, i, j)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
      (Result (a, b, c, d, e, f, g, h, i, j)))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (a, b, c, d, e, f, g, h, i, j)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (Result (a, b, c, d, e, f, g, h, i, j))
forall a b. (a -> b) -> a -> b
$ (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (a
      -> b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (a
   -> b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_,h
_,i
_,j
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_,h
_,i
_,j
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_,h
_,i
_,j
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_,h
_,i
_,j
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) g
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p,h
_,i
_,j
_) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) h
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) h
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) h
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> h)
-> UnjsonDef h
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) h
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
7 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
p,i
_,j
_) -> h
p) UnjsonDef h
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) i
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (j -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) i
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) i
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> i)
-> UnjsonDef i
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) i
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
8 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
p,j
_) -> i
p) UnjsonDef i
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
  (j -> (a, b, c, d, e, f, g, h, i, j))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) j
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j))
     (a, b, c, d, e, f, g, h, i, j)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) j
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j)) j
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j) -> j)
-> UnjsonDef j
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j) j
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
9 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
p) -> j
p) UnjsonDef j
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g,Unjson h
         ,Unjson i,Unjson j,Unjson k)
       => Unjson (a,b,c,d
                 ,e,f,g,h
                 ,i,j,k) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g, h, i, j, k)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (Result (a, b, c, d, e, f, g, h, i, j, k))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
   (Result (a, b, c, d, e, f, g, h, i, j, k))
 -> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (Result (a, b, c, d, e, f, g, h, i, j, k))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g, h, i, j, k)
 -> Result (a, b, c, d, e, f, g, h, i, j, k))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (a, b, c, d, e, f, g, h, i, j, k)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (Result (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g, h, i, j, k)
-> Result (a, b, c, d, e, f, g, h, i, j, k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
   (a, b, c, d, e, f, g, h, i, j, k)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
      (Result (a, b, c, d, e, f, g, h, i, j, k)))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (a, b, c, d, e, f, g, h, i, j, k)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (Result (a, b, c, d, e, f, g, h, i, j, k))
forall a b. (a -> b) -> a -> b
$ (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (a
      -> b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (a
   -> b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (e
      -> f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_,h
_,i
_,j
_,k
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (e
   -> f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_,h
_,i
_,j
_,k
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_,h
_,i
_,j
_,k
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) g
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p,h
_,i
_,j
_,k
_) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) h
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) h
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) h
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> h)
-> UnjsonDef h
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) h
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
7 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
p,i
_,j
_,k
_) -> h
p) UnjsonDef h
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) i
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) i
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) i
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> i)
-> UnjsonDef i
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) i
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
8 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
p,j
_,k
_) -> i
p) UnjsonDef i
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) j
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) j
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) j
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> j)
-> UnjsonDef j
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) j
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
9 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
p,k
_) -> j
p) UnjsonDef j
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
  (k -> (a, b, c, d, e, f, g, h, i, j, k))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) k
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k))
     (a, b, c, d, e, f, g, h, i, j, k)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) k
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k)) k
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k) -> k)
-> UnjsonDef k
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k) k
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
10 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
p) -> k
p) UnjsonDef k
forall a. Unjson a => UnjsonDef a
unjsonDef)

instance (Unjson a,Unjson b,Unjson c,Unjson d
         ,Unjson e,Unjson f,Unjson g,Unjson h
         ,Unjson i,Unjson j,Unjson k,Unjson l)
       => Unjson (a,b,c,d
                 ,e,f,g,h
                 ,i,j,k,l) where
  unjsonDef :: UnjsonDef (a, b, c, d, e, f, g, h, i, j, k, l)
unjsonDef = Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (Result (a, b, c, d, e, f, g, h, i, j, k, l))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k, l)
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
   (Result (a, b, c, d, e, f, g, h, i, j, k, l))
 -> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (Result (a, b, c, d, e, f, g, h, i, j, k, l))
-> UnjsonDef (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b. (a -> b) -> a -> b
$ ((a, b, c, d, e, f, g, h, i, j, k, l)
 -> Result (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (a, b, c, d, e, f, g, h, i, j, k, l)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (Result (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c, d, e, f, g, h, i, j, k, l)
-> Result (a, b, c, d, e, f, g, h, i, j, k, l)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
               (Ap
   (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
   (a, b, c, d, e, f, g, h, i, j, k, l)
 -> Ap
      (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
      (Result (a, b, c, d, e, f, g, h, i, j, k, l)))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (a, b, c, d, e, f, g, h, i, j, k, l)
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (Result (a, b, c, d, e, f, g, h, i, j, k, l))
forall a b. (a -> b) -> a -> b
$ (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (a
      -> b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,,,,,,,,,)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (a
   -> b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) a
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) a
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> a)
-> UnjsonDef a
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) a
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
0 (\(a
p,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_,l
_) -> a
p) UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) b
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) b
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) b
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> b)
-> UnjsonDef b
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) b
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
1 (\(a
_,b
p,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_,l
_) -> b
p) UnjsonDef b
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) c
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) c
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) c
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> c)
-> UnjsonDef c
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) c
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
2 (\(a
_,b
_,c
p,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_,l
_) -> c
p) UnjsonDef c
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) d
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) d
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) d
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> d)
-> UnjsonDef d
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) d
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
3 (\(a
_,b
_,c
_,d
p,e
_,f
_,g
_,h
_,i
_,j
_,k
_,l
_) -> d
p) UnjsonDef d
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) e
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) e
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) e
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> e)
-> UnjsonDef e
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) e
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
4 (\(a
_,b
_,c
_,d
_,e
p,f
_,g
_,h
_,i
_,j
_,k
_,l
_) -> e
p) UnjsonDef e
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (f
   -> g
   -> h
   -> i
   -> j
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) f
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (g
      -> h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) f
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) f
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> f)
-> UnjsonDef f
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) f
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
5 (\(a
_,b
_,c
_,d
_,e
_,f
p,g
_,h
_,i
_,j
_,k
_,l
_) -> f
p) UnjsonDef f
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (g
   -> h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) g
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) g
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) g
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> g)
-> UnjsonDef g
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) g
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
6 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
p,h
_,i
_,j
_,k
_,l
_) -> g
p) UnjsonDef g
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) h
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) h
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) h
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> h)
-> UnjsonDef h
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) h
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
7 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
p,i
_,j
_,k
_,l
_) -> h
p) UnjsonDef h
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) i
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) i
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) i
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> i)
-> UnjsonDef i
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) i
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
8 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
p,j
_,k
_,l
_) -> i
p) UnjsonDef i
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) j
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) j
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) j
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> j)
-> UnjsonDef j
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) j
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
9 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
p,k
_,l
_) -> j
p) UnjsonDef j
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) k
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) k
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) k
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> k)
-> UnjsonDef k
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) k
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
10 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
p,l
_) -> k
p) UnjsonDef k
forall a. Unjson a => UnjsonDef a
unjsonDef)
               Ap
  (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
  (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) l
-> Ap
     (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l))
     (a, b, c, d, e, f, g, h, i, j, k, l)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) l
-> Ap (TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l)) l
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Int
-> ((a, b, c, d, e, f, g, h, i, j, k, l) -> l)
-> UnjsonDef l
-> TupleFieldDef (a, b, c, d, e, f, g, h, i, j, k, l) l
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
11 (\(a
_,b
_,c
_,d
_,e
_,f
_,g
_,h
_,i
_,j
_,k
_,l
p) -> l
p) UnjsonDef l
forall a. Unjson a => UnjsonDef a
unjsonDef)

-- | Specify how arrays should be handled. Default is
-- 'ArrayModeStrict' that does not do anything special with
-- arrays.
--
-- 'ArrayMode' is used in 'arrayWithModeAndPrimaryKeyOf' and
-- 'arrayWithModeOf'.
data ArrayMode
  -- | Require JSON array. On output always output array.
  = ArrayModeStrict

  -- | Allow non-array element, in that case it will be treated as a
  -- single element array. On output always output array.
  | ArrayModeParseSingle

  -- | Allow non-array element, in that case it will be treated as a
  -- single element array. On output output single element if array
  -- has one element.
  | ArrayModeParseAndOutputSingle
  deriving (ArrayMode -> ArrayMode -> Bool
(ArrayMode -> ArrayMode -> Bool)
-> (ArrayMode -> ArrayMode -> Bool) -> Eq ArrayMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayMode -> ArrayMode -> Bool
$c/= :: ArrayMode -> ArrayMode -> Bool
== :: ArrayMode -> ArrayMode -> Bool
$c== :: ArrayMode -> ArrayMode -> Bool
Eq, Eq ArrayMode
Eq ArrayMode
-> (ArrayMode -> ArrayMode -> Ordering)
-> (ArrayMode -> ArrayMode -> Bool)
-> (ArrayMode -> ArrayMode -> Bool)
-> (ArrayMode -> ArrayMode -> Bool)
-> (ArrayMode -> ArrayMode -> Bool)
-> (ArrayMode -> ArrayMode -> ArrayMode)
-> (ArrayMode -> ArrayMode -> ArrayMode)
-> Ord ArrayMode
ArrayMode -> ArrayMode -> Bool
ArrayMode -> ArrayMode -> Ordering
ArrayMode -> ArrayMode -> ArrayMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrayMode -> ArrayMode -> ArrayMode
$cmin :: ArrayMode -> ArrayMode -> ArrayMode
max :: ArrayMode -> ArrayMode -> ArrayMode
$cmax :: ArrayMode -> ArrayMode -> ArrayMode
>= :: ArrayMode -> ArrayMode -> Bool
$c>= :: ArrayMode -> ArrayMode -> Bool
> :: ArrayMode -> ArrayMode -> Bool
$c> :: ArrayMode -> ArrayMode -> Bool
<= :: ArrayMode -> ArrayMode -> Bool
$c<= :: ArrayMode -> ArrayMode -> Bool
< :: ArrayMode -> ArrayMode -> Bool
$c< :: ArrayMode -> ArrayMode -> Bool
compare :: ArrayMode -> ArrayMode -> Ordering
$ccompare :: ArrayMode -> ArrayMode -> Ordering
$cp1Ord :: Eq ArrayMode
Ord, Int -> ArrayMode -> ShowS
[ArrayMode] -> ShowS
ArrayMode -> String
(Int -> ArrayMode -> ShowS)
-> (ArrayMode -> String)
-> ([ArrayMode] -> ShowS)
-> Show ArrayMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayMode] -> ShowS
$cshowList :: [ArrayMode] -> ShowS
show :: ArrayMode -> String
$cshow :: ArrayMode -> String
showsPrec :: Int -> ArrayMode -> ShowS
$cshowsPrec :: Int -> ArrayMode -> ShowS
Show, Typeable)

-- | 'PrimaryKeyExtraction' is needed to keep 'Ord pk' constraint
-- attached. Elements of array may be matched based on a primary
-- key. A primary key has to be extracted both from existing array
-- structure and from JSON array elements. Then a 'Set' is constructed
-- so that lookups are efficient. Then for each element in JSON a
-- corresponding element in old object is looked for. If found the
-- element is updated, if not found it is parsed fresh.
data PrimaryKeyExtraction k = forall pk . (Ord pk) => PrimaryKeyExtraction (k -> pk) (UnjsonDef pk)

-- | Opaque 'UnjsonDef' defines a bidirectional JSON parser.
data UnjsonDef a where
  SimpleUnjsonDef   :: Text.Text -> (Aeson.Value -> Result k) -> (k -> Aeson.Value) -> UnjsonDef k
  ArrayUnjsonDef    :: Typeable k => Maybe (PrimaryKeyExtraction k) -> ArrayMode -> ([k] -> Result v) -> (v -> [k]) -> UnjsonDef k -> UnjsonDef v
  ObjectUnjsonDef   :: Ap (FieldDef k) (Result k) -> UnjsonDef k
  TupleUnjsonDef    :: Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
  DisjointUnjsonDef :: Text.Text -> [(Text.Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
  UnionUnjsonDef    :: [(k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
  MapUnjsonDef      :: Typeable k => UnjsonDef k -> (AC.KeyMap k -> Result v) -> (v -> AC.KeyMap k) -> UnjsonDef v

instance Invariant UnjsonDef where
  invmap :: (a -> b) -> (b -> a) -> UnjsonDef a -> UnjsonDef b
invmap a -> b
f b -> a
g (SimpleUnjsonDef Text
name Value -> Result a
p a -> Value
s) = Text -> (Value -> Result b) -> (b -> Value) -> UnjsonDef b
forall k.
Text -> (Value -> Result k) -> (k -> Value) -> UnjsonDef k
SimpleUnjsonDef Text
name ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b) -> (Value -> Result a) -> Value -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
p) (a -> Value
s (a -> Value) -> (b -> a) -> b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)
  invmap a -> b
f b -> a
g (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
mpk ArrayMode
am [k] -> Result a
n a -> [k]
k UnjsonDef k
d) = Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result b)
-> (b -> [k])
-> UnjsonDef k
-> UnjsonDef b
forall k v.
Typeable k =>
Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result v)
-> (v -> [k])
-> UnjsonDef k
-> UnjsonDef v
ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
mpk ArrayMode
am ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b) -> ([k] -> Result a) -> [k] -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> Result a
n) (a -> [k]
k (a -> [k]) -> (b -> a) -> b -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) UnjsonDef k
d
  invmap a -> b
f b -> a
g (MapUnjsonDef UnjsonDef k
d KeyMap k -> Result a
n a -> KeyMap k
k) = UnjsonDef k
-> (KeyMap k -> Result b) -> (b -> KeyMap k) -> UnjsonDef b
forall k v.
Typeable k =>
UnjsonDef k
-> (KeyMap k -> Result v) -> (v -> KeyMap k) -> UnjsonDef v
MapUnjsonDef UnjsonDef k
d ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Result a -> Result b)
-> (KeyMap k -> Result a) -> KeyMap k -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap k -> Result a
n) (a -> KeyMap k
k (a -> KeyMap k) -> (b -> a) -> b -> KeyMap k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)
  invmap a -> b
f b -> a
g (ObjectUnjsonDef Ap (FieldDef a) (Result a)
fd) = Ap (FieldDef b) (Result b) -> UnjsonDef b
forall k. Ap (FieldDef k) (Result k) -> UnjsonDef k
ObjectUnjsonDef ((Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
fd))
  invmap a -> b
f b -> a
g (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
td) = Ap (TupleFieldDef b) (Result b) -> UnjsonDef b
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef ((Result a -> Result b)
-> Ap (TupleFieldDef b) (Result a)
-> Ap (TupleFieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((forall a. TupleFieldDef a a -> TupleFieldDef b a)
-> Ap (TupleFieldDef a) (Result a)
-> Ap (TupleFieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> TupleFieldDef a a -> TupleFieldDef b a
forall b a x. (b -> a) -> TupleFieldDef a x -> TupleFieldDef b x
contramapTupleFieldDef b -> a
g) Ap (TupleFieldDef a) (Result a)
td))
  invmap a -> b
f b -> a
g (DisjointUnjsonDef Text
d [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) = Text
-> [(Text, b -> Bool, Ap (FieldDef b) (Result b))] -> UnjsonDef b
forall k.
Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
DisjointUnjsonDef Text
d (((Text, a -> Bool, Ap (FieldDef a) (Result a))
 -> (Text, b -> Bool, Ap (FieldDef b) (Result b)))
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
-> [(Text, b -> Bool, Ap (FieldDef b) (Result b))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,a -> Bool
b,Ap (FieldDef a) (Result a)
c) -> (Text
a,a -> Bool
b (a -> Bool) -> (b -> a) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g,(Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
c))) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l)
  invmap a -> b
f b -> a
g (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
l) = [(b -> Bool, Ap (FieldDef b) (Result b))] -> UnjsonDef b
forall k. [(k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
UnionUnjsonDef (((a -> Bool, Ap (FieldDef a) (Result a))
 -> (b -> Bool, Ap (FieldDef b) (Result b)))
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [(b -> Bool, Ap (FieldDef b) (Result b))]
forall a b. (a -> b) -> [a] -> [b]
map (\(a -> Bool
b,Ap (FieldDef a) (Result a)
c) -> (a -> Bool
b (a -> Bool) -> (b -> a) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g,(Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
c))) [(a -> Bool, Ap (FieldDef a) (Result a))]
l)

unjsonInvmapR :: (a -> Result b) -> (b -> a) -> UnjsonDef a -> UnjsonDef b
unjsonInvmapR :: (a -> Result b) -> (b -> a) -> UnjsonDef a -> UnjsonDef b
unjsonInvmapR a -> Result b
f b -> a
g (SimpleUnjsonDef Text
name Value -> Result a
p a -> Value
s) = Text -> (Value -> Result b) -> (b -> Value) -> UnjsonDef b
forall k.
Text -> (Value -> Result k) -> (k -> Value) -> UnjsonDef k
SimpleUnjsonDef Text
name (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (Value -> Result (Result b)) -> Value -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f (Result a -> Result (Result b))
-> (Value -> Result a) -> Value -> Result (Result b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
p) (a -> Value
s (a -> Value) -> (b -> a) -> b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)
unjsonInvmapR a -> Result b
f b -> a
g (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
mpk ArrayMode
am [k] -> Result a
n a -> [k]
k UnjsonDef k
d) = Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result b)
-> (b -> [k])
-> UnjsonDef k
-> UnjsonDef b
forall k v.
Typeable k =>
Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result v)
-> (v -> [k])
-> UnjsonDef k
-> UnjsonDef v
ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
mpk ArrayMode
am (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> ([k] -> Result (Result b)) -> [k] -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f (Result a -> Result (Result b))
-> ([k] -> Result a) -> [k] -> Result (Result b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> Result a
n) (a -> [k]
k (a -> [k]) -> (b -> a) -> b -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) UnjsonDef k
d
unjsonInvmapR a -> Result b
f b -> a
g (MapUnjsonDef UnjsonDef k
d KeyMap k -> Result a
n a -> KeyMap k
k) = UnjsonDef k
-> (KeyMap k -> Result b) -> (b -> KeyMap k) -> UnjsonDef b
forall k v.
Typeable k =>
UnjsonDef k
-> (KeyMap k -> Result v) -> (v -> KeyMap k) -> UnjsonDef v
MapUnjsonDef UnjsonDef k
d (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (KeyMap k -> Result (Result b)) -> KeyMap k -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f (Result a -> Result (Result b))
-> (KeyMap k -> Result a) -> KeyMap k -> Result (Result b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap k -> Result a
n) (a -> KeyMap k
k (a -> KeyMap k) -> (b -> a) -> b -> KeyMap k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)
unjsonInvmapR a -> Result b
f b -> a
g (ObjectUnjsonDef Ap (FieldDef a) (Result a)
fd) = Ap (FieldDef b) (Result b) -> UnjsonDef b
forall k. Ap (FieldDef k) (Result k) -> UnjsonDef k
ObjectUnjsonDef ((Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (Result a -> Result (Result b)) -> Result a -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
fd))
unjsonInvmapR a -> Result b
f b -> a
g (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
td) = Ap (TupleFieldDef b) (Result b) -> UnjsonDef b
forall k. Ap (TupleFieldDef k) (Result k) -> UnjsonDef k
TupleUnjsonDef ((Result a -> Result b)
-> Ap (TupleFieldDef b) (Result a)
-> Ap (TupleFieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (Result a -> Result (Result b)) -> Result a -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f) ((forall a. TupleFieldDef a a -> TupleFieldDef b a)
-> Ap (TupleFieldDef a) (Result a)
-> Ap (TupleFieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> TupleFieldDef a a -> TupleFieldDef b a
forall b a x. (b -> a) -> TupleFieldDef a x -> TupleFieldDef b x
contramapTupleFieldDef b -> a
g) Ap (TupleFieldDef a) (Result a)
td))
unjsonInvmapR a -> Result b
f b -> a
g (DisjointUnjsonDef Text
d [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) = Text
-> [(Text, b -> Bool, Ap (FieldDef b) (Result b))] -> UnjsonDef b
forall k.
Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
DisjointUnjsonDef Text
d (((Text, a -> Bool, Ap (FieldDef a) (Result a))
 -> (Text, b -> Bool, Ap (FieldDef b) (Result b)))
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
-> [(Text, b -> Bool, Ap (FieldDef b) (Result b))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,a -> Bool
b,Ap (FieldDef a) (Result a)
c) -> (Text
a,a -> Bool
b (a -> Bool) -> (b -> a) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g,(Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (Result a -> Result (Result b)) -> Result a -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
c))) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l)
unjsonInvmapR a -> Result b
f b -> a
g (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
l) = [(b -> Bool, Ap (FieldDef b) (Result b))] -> UnjsonDef b
forall k. [(k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
UnionUnjsonDef (((a -> Bool, Ap (FieldDef a) (Result a))
 -> (b -> Bool, Ap (FieldDef b) (Result b)))
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [(b -> Bool, Ap (FieldDef b) (Result b))]
forall a b. (a -> b) -> [a] -> [b]
map (\(a -> Bool
b,Ap (FieldDef a) (Result a)
c) -> (a -> Bool
b (a -> Bool) -> (b -> a) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g,(Result a -> Result b)
-> Ap (FieldDef b) (Result a) -> Ap (FieldDef b) (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result (Result b) -> Result b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result b) -> Result b)
-> (Result a -> Result (Result b)) -> Result a -> Result b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result b) -> Result a -> Result (Result b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result b
f) ((forall a. FieldDef a a -> FieldDef b a)
-> Ap (FieldDef a) (Result a) -> Ap (FieldDef b) (Result a)
forall (f :: * -> *) (g :: * -> *) b.
(forall a. f a -> g a) -> Ap f b -> Ap g b
hoistAp ((b -> a) -> FieldDef a a -> FieldDef b a
forall b a x. (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
g) Ap (FieldDef a) (Result a)
c))) [(a -> Bool, Ap (FieldDef a) (Result a))]
l)

-- Note: contramapFieldDef and contramapTupleFieldDef are basically
-- Contravariant, but due to type parameters in wrong order we would
-- need to do some type shuffling to get it right. Easier to just
-- write it here as it is.
contramapFieldDef :: (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef :: (b -> a) -> FieldDef a x -> FieldDef b x
contramapFieldDef b -> a
f (FieldReqDef Text
name Text
doc a -> x
ext UnjsonDef x
d) = Text -> Text -> (b -> x) -> UnjsonDef x -> FieldDef b x
forall a s.
Typeable a =>
Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s a
FieldReqDef Text
name Text
doc (a -> x
ext (a -> x) -> (b -> a) -> b -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) UnjsonDef x
d
contramapFieldDef b -> a
f (FieldOptDef Text
name Text
doc a -> Maybe a
ext UnjsonDef a
d) = Text
-> Text -> (b -> Maybe a) -> UnjsonDef a -> FieldDef b (Maybe a)
forall a s.
Typeable a =>
Text
-> Text -> (s -> Maybe a) -> UnjsonDef a -> FieldDef s (Maybe a)
FieldOptDef Text
name Text
doc (a -> Maybe a
ext (a -> Maybe a) -> (b -> a) -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) UnjsonDef a
d
contramapFieldDef b -> a
f (FieldDefDef Text
name Text
doc x
def a -> x
ext UnjsonDef x
d) = Text -> Text -> x -> (b -> x) -> UnjsonDef x -> FieldDef b x
forall a s.
Typeable a =>
Text -> Text -> a -> (s -> a) -> UnjsonDef a -> FieldDef s a
FieldDefDef Text
name Text
doc x
def (a -> x
ext (a -> x) -> (b -> a) -> b -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) UnjsonDef x
d
contramapFieldDef b -> a
f (FieldRODef Text
name Text
doc a -> a
ext UnjsonDef a
d) = Text -> Text -> (b -> a) -> UnjsonDef a -> FieldDef b ()
forall a s.
Typeable a =>
Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s ()
FieldRODef Text
name Text
doc (a -> a
ext (a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) UnjsonDef a
d

contramapTupleFieldDef :: (b -> a) -> TupleFieldDef a x -> TupleFieldDef b x
contramapTupleFieldDef :: (b -> a) -> TupleFieldDef a x -> TupleFieldDef b x
contramapTupleFieldDef b -> a
f (TupleFieldDef Int
i a -> x
e UnjsonDef x
d) = Int -> (b -> x) -> UnjsonDef x -> TupleFieldDef b x
forall s a. Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a
TupleFieldDef Int
i (a -> x
e (a -> x) -> (b -> a) -> b -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f) UnjsonDef x
d

-- | Define a relation between a field of an object in JSON and a
-- field in a Haskell record structure.  'FieldDef' holds information
-- about a documentation string, key name, Haskell data accessor and
-- parsing definition.  'FieldDef' has three cases for fields that are
-- required, optional (via 'Maybe') or jave default value.
data FieldDef s a where
  FieldReqDef :: Typeable a => Text.Text -> Text.Text -> (s -> a)       -> UnjsonDef a -> FieldDef s a
  FieldOptDef :: Typeable a => Text.Text -> Text.Text -> (s -> Maybe a) -> UnjsonDef a -> FieldDef s (Maybe a)
  FieldDefDef :: Typeable a => Text.Text -> Text.Text -> a -> (s -> a)  -> UnjsonDef a -> FieldDef s a
  FieldRODef  :: Typeable a => Text.Text -> Text.Text -> (s -> a)       -> UnjsonDef a -> FieldDef s ()

-- | Define a tuple element. 'TupleFieldDef' holds information about
-- index, accessor function and a parser definition.
data TupleFieldDef s a where
  TupleFieldDef :: Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a

tupleDefToArray :: (forall b . UnjsonDef b -> b -> v) -> s -> Ap (TupleFieldDef s) a -> [v]
tupleDefToArray :: (forall b. UnjsonDef b -> b -> v)
-> s -> Ap (TupleFieldDef s) a -> [v]
tupleDefToArray forall b. UnjsonDef b -> b -> v
_sx s
_ (Pure a
_) = []
tupleDefToArray  forall b. UnjsonDef b -> b -> v
sx s
s (Ap (TupleFieldDef Int
_ s -> a1
f UnjsonDef a1
d) Ap (TupleFieldDef s) (a1 -> a)
r) =  (UnjsonDef a1 -> a1 -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef a1
d (s -> a1
f s
s)) v -> [v] -> [v]
forall a. a -> [a] -> [a]
: (forall b. UnjsonDef b -> b -> v)
-> s -> Ap (TupleFieldDef s) (a1 -> a) -> [v]
forall v s a.
(forall b. UnjsonDef b -> b -> v)
-> s -> Ap (TupleFieldDef s) a -> [v]
tupleDefToArray forall b. UnjsonDef b -> b -> v
sx s
s Ap (TupleFieldDef s) (a1 -> a)
r


objectDefToArray :: Bool -> (forall b . UnjsonDef b -> b -> v) -> s -> Ap (FieldDef s) a -> [(Text.Text,v)]
objectDefToArray :: Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
_ forall b. UnjsonDef b -> b -> v
_sx s
_ (Pure a
_) = []
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s (Ap (FieldReqDef Text
key Text
_ s -> a1
f UnjsonDef a1
d) Ap (FieldDef s) (a1 -> a)
r) = (Text
key,UnjsonDef a1 -> a1 -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef a1
d (s -> a1
f s
s)) (Text, v) -> [(Text, v)] -> [(Text, v)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) (a1 -> a)
-> [(Text, v)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s Ap (FieldDef s) (a1 -> a)
r
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s (Ap (FieldOptDef Text
key Text
_ s -> Maybe a
f UnjsonDef a
d) Ap (FieldDef s) (a1 -> a)
r) =
  case s -> Maybe a
f s
s of
    Maybe a
Nothing -> (if Bool
explicitNulls then [(Text
key,UnjsonDef Value -> Value -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef Value
forall a. Unjson a => UnjsonDef a
unjsonDef Value
Aeson.Null)] else []) [(Text, v)] -> [(Text, v)] -> [(Text, v)]
forall a. [a] -> [a] -> [a]
++ Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) (a1 -> a)
-> [(Text, v)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s Ap (FieldDef s) (a1 -> a)
r
    Just a
g ->  (Text
key,UnjsonDef a -> a -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef a
d a
g) (Text, v) -> [(Text, v)] -> [(Text, v)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) (a1 -> a)
-> [(Text, v)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s Ap (FieldDef s) (a1 -> a)
r
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s (Ap (FieldDefDef Text
key Text
_ a1
_ s -> a1
f UnjsonDef a1
d) Ap (FieldDef s) (a1 -> a)
r) = (Text
key,UnjsonDef a1 -> a1 -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef a1
d (s -> a1
f s
s)) (Text, v) -> [(Text, v)] -> [(Text, v)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) (a1 -> a)
-> [(Text, v)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s Ap (FieldDef s) (a1 -> a)
r
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s (Ap (FieldRODef  Text
key Text
_ s -> a
f UnjsonDef a
d) Ap (FieldDef s) (a1 -> a)
r) = (Text
key,UnjsonDef a -> a -> v
forall b. UnjsonDef b -> b -> v
sx UnjsonDef a
d (s -> a
f s
s)) (Text, v) -> [(Text, v)] -> [(Text, v)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) (a1 -> a)
-> [(Text, v)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray Bool
explicitNulls forall b. UnjsonDef b -> b -> v
sx s
s Ap (FieldDef s) (a1 -> a)
r

-- | Formatting options when serializing to JSON. Used in
-- 'unjsonToJSON'', 'unjsonToByteStringLazy'' and
-- 'unjsonToByteStringBuilder''.
data Options = Options
  { Options -> Bool
pretty :: Bool -- ^ Pretty format. Use spaces and newlines.
  , Options -> Int
indent :: Int  -- ^ Amount of spaces for indent. 4 looks good.
  , Options -> Bool
nulls  :: Bool -- ^ Output explicit nulls for absent optional fields.
  }
  deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Eq Options
Eq Options
-> (Options -> Options -> Ordering)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Bool)
-> (Options -> Options -> Options)
-> (Options -> Options -> Options)
-> Ord Options
Options -> Options -> Bool
Options -> Options -> Ordering
Options -> Options -> Options
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Options -> Options -> Options
$cmin :: Options -> Options -> Options
max :: Options -> Options -> Options
$cmax :: Options -> Options -> Options
>= :: Options -> Options -> Bool
$c>= :: Options -> Options -> Bool
> :: Options -> Options -> Bool
$c> :: Options -> Options -> Bool
<= :: Options -> Options -> Bool
$c<= :: Options -> Options -> Bool
< :: Options -> Options -> Bool
$c< :: Options -> Options -> Bool
compare :: Options -> Options -> Ordering
$ccompare :: Options -> Options -> Ordering
$cp1Ord :: Eq Options
Ord, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

-- | Given a definition of a value and a value produce a
-- 'Aeson.Value'.
--
-- Example:
--
-- > let v = Thing { ... }
-- > let json = unjsonToJSON unjsonThing v
--
unjsonToJSON :: UnjsonDef a -> a -> Aeson.Value
unjsonToJSON :: UnjsonDef a -> a -> Value
unjsonToJSON = Options -> UnjsonDef a -> a -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' (Options :: Bool -> Int -> Bool -> Options
Options { pretty :: Bool
pretty = Bool
False, indent :: Int
indent = Int
4, nulls :: Bool
nulls = Bool
False })

-- | Given a definition of a value and a value produce a
-- 'Aeson.Value'. Takes 'Options'.
--
-- Example:
--
-- > let v = Thing { ... }
-- > let json = unjsonToJSON' options unjsonThing v
--
unjsonToJSON' :: Options -> UnjsonDef a -> a -> Aeson.Value
unjsonToJSON' :: Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
_ (SimpleUnjsonDef Text
_ Value -> Result a
_ a -> Value
g) a
a = a -> Value
g a
a
unjsonToJSON' Options
opt (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
_ ArrayMode
m [k] -> Result a
_g a -> [k]
k UnjsonDef k
f) a
a =
  case (ArrayMode
m, a -> [k]
k a
a) of
    (ArrayMode
ArrayModeParseAndOutputSingle,[k
b]) -> Options -> UnjsonDef k -> k -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt UnjsonDef k
f k
b
    (ArrayMode
_,[k]
c) -> [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ((k -> Value) -> [k] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Options -> UnjsonDef k -> k -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt UnjsonDef k
f) [k]
c)
unjsonToJSON' Options
opt (ObjectUnjsonDef Ap (FieldDef a) (Result a)
f) a
a =
  [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Text, Value) -> Pair
AC.convertPair ((Text, Value) -> Pair) -> [(Text, Value)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
-> (forall b. UnjsonDef b -> b -> Value)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Value)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Options -> UnjsonDef b -> b -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt) a
a Ap (FieldDef a) (Result a)
f)
unjsonToJSON' Options
opt (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
f) a
a =
  [Value] -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ((forall b. UnjsonDef b -> b -> Value)
-> a -> Ap (TupleFieldDef a) (Result a) -> [Value]
forall v s a.
(forall b. UnjsonDef b -> b -> v)
-> s -> Ap (TupleFieldDef s) a -> [v]
tupleDefToArray (Options -> UnjsonDef b -> b -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt) a
a Ap (TupleFieldDef a) (Result a)
f)
unjsonToJSON' Options
opt (DisjointUnjsonDef Text
k [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) a
a =
  [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Text, Value) -> Pair
AC.convertPair ((Text, Value) -> Pair) -> [(Text, Value)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text
k,Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
nm) (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> Value)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Value)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Options -> UnjsonDef b -> b -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt) a
a Ap (FieldDef a) (Result a)
f)
  where
    [(Text
nm,a -> Bool
_,Ap (FieldDef a) (Result a)
f)] = ((Text, a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
_,a -> Bool
is,Ap (FieldDef a) (Result a)
_) -> a -> Bool
is a
a) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l
unjsonToJSON' Options
opt (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
l) a
a =
  [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Text, Value) -> Pair
AC.convertPair ((Text, Value) -> Pair) -> [(Text, Value)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
-> (forall b. UnjsonDef b -> b -> Value)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Value)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Options -> UnjsonDef b -> b -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt) a
a Ap (FieldDef a) (Result a)
f)
  where
    [(a -> Bool
_,Ap (FieldDef a) (Result a)
f)] = ((a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a -> Bool
is,Ap (FieldDef a) (Result a)
_) -> a -> Bool
is a
a) [(a -> Bool, Ap (FieldDef a) (Result a))]
l
unjsonToJSON' Options
opt (MapUnjsonDef UnjsonDef k
f KeyMap k -> Result a
_ a -> KeyMap k
g) a
a =
  Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (k -> Value) -> KeyMap k -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> UnjsonDef k -> k -> Value
forall a. Options -> UnjsonDef a -> a -> Value
unjsonToJSON' Options
opt UnjsonDef k
f) (a -> KeyMap k
g a
a)

-- | Given a definition of a value and a value produce a 'BSL.ByteString'.
--
-- Example:
--
-- > let v = Thing { ... }
-- > let utf8bsrep = unjsonToByteStringLazy unjsonThing v
--
unjsonToByteStringLazy :: UnjsonDef a -> a -> BSL.ByteString
unjsonToByteStringLazy :: UnjsonDef a -> a -> ByteString
unjsonToByteStringLazy = Options -> UnjsonDef a -> a -> ByteString
forall a. Options -> UnjsonDef a -> a -> ByteString
unjsonToByteStringLazy' (Options :: Bool -> Int -> Bool -> Options
Options { pretty :: Bool
pretty = Bool
False, indent :: Int
indent = Int
4, nulls :: Bool
nulls = Bool
False })

-- | Given a definition of a value and a value produce a
-- 'BSL.ByteString'. Also takes formatting 'Options'.
--
-- Example:
--
-- > let v = Thing { ... }
-- > let utf8bsrep = unjsonToByteStringLazy' options unjsonThing v
--
unjsonToByteStringLazy' :: Options -> UnjsonDef a -> a -> BSL.ByteString
unjsonToByteStringLazy' :: Options -> UnjsonDef a -> a -> ByteString
unjsonToByteStringLazy' Options
opt UnjsonDef a
ud a
a = Builder -> ByteString
Builder.toLazyByteString (Options -> UnjsonDef a -> a -> Builder
forall a. Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder' Options
opt UnjsonDef a
ud a
a)


unjsonGroup :: Int -> Options -> Builder.Builder -> Builder.Builder -> (a -> Builder.Builder) -> [a] -> Builder.Builder
unjsonGroup :: Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
_level Options
_ Builder
open Builder
close a -> Builder
_peritem [] =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder
open, Builder
close]
unjsonGroup Int
level Options
opt Builder
open Builder
close a -> Builder
peritem [a]
items =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder
open, Builder
newline] [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
Builder.char8 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
newline) ((a -> Builder) -> [a] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((Builder
idnt2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder) -> (a -> Builder) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
peritem) [a]
items) [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++ [Builder
newline, Builder
idnt, Builder
close]
  where
    newline :: Builder.Builder
    newline :: Builder
newline = if Options -> Bool
pretty Options
opt then Char -> Builder
Builder.char8 Char
'\n' else Builder
forall a. Monoid a => a
mempty
    idnt :: Builder.Builder
    idnt :: Builder
idnt = if Options -> Bool
pretty Options
opt then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Int -> [Builder] -> [Builder]
forall a. Int -> [a] -> [a]
take Int
level (Builder -> [Builder]
forall a. a -> [a]
repeat (Char -> Builder
Builder.char8 Char
' '))) else Builder
forall a. Monoid a => a
mempty
    idnt2 :: Builder.Builder
    idnt2 :: Builder
idnt2 = if Options -> Bool
pretty Options
opt then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Int -> [Builder] -> [Builder]
forall a. Int -> [a] -> [a]
take (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Options -> Int
indent Options
opt) (Builder -> [Builder]
forall a. a -> [a]
repeat (Char -> Builder
Builder.char8 Char
' '))) else Builder
forall a. Monoid a => a
mempty

-- | Given a definition of a value and a value produce a
-- 'Builder.Builder'. Functionally it is the same as
-- 'unjsonToByteStringLazy' but useful if json serialization is a part
-- of some bigger serialization function. Also takes formatting
-- 'Options'.
unjsonToByteStringBuilder' :: Options -> UnjsonDef a -> a -> Builder.Builder
unjsonToByteStringBuilder' :: Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder' = Int -> Options -> UnjsonDef a -> a -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' Int
0

-- | Given a definition of a value and a value produce a
-- 'Builder.Builder'. Functionally it is the same as
-- 'unjsonToByteStringLazy' but useful if json serialization is a part
-- of some bigger serialization function.
unjsonToByteStringBuilder :: UnjsonDef a -> a -> Builder.Builder
unjsonToByteStringBuilder :: UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder = Options -> UnjsonDef a -> a -> Builder
forall a. Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder' (Options :: Bool -> Int -> Bool -> Options
Options { pretty :: Bool
pretty = Bool
False, indent :: Int
indent = Int
4, nulls :: Bool
nulls = Bool
False })

-- | Given a definition of a value and a value produce a
-- 'Builder.Builder'. Useful when JSON serialization is
-- a part of a bigger serialization function.
unjsonToByteStringBuilder'' :: Int -> Options -> UnjsonDef a -> a -> Builder.Builder
unjsonToByteStringBuilder'' :: Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' Int
_level Options
_opt (SimpleUnjsonDef Text
_ Value -> Result a
_ a -> Value
g) a
a = ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (a -> Value
g a
a))
unjsonToByteStringBuilder''  Int
level  Options
opt (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
_ ArrayMode
m [k] -> Result a
_g a -> [k]
k UnjsonDef k
f) a
a =
  case (ArrayMode
m, a -> [k]
k a
a) of
    (ArrayMode
ArrayModeParseAndOutputSingle,[k
b]) -> Int -> Options -> UnjsonDef k -> k -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' Int
level Options
opt UnjsonDef k
f k
b
    (ArrayMode
_,[k]
c) -> Int
-> Options
-> Builder
-> Builder
-> (k -> Builder)
-> [k]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'[') (Char -> Builder
Builder.char8 Char
']') (Int -> Options -> UnjsonDef k -> k -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
levelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Options -> Int
indent Options
opt) Options
opt UnjsonDef k
f) [k]
c
unjsonToByteStringBuilder'' Int
level Options
opt (ObjectUnjsonDef Ap (FieldDef a) (Result a)
f) a
a =
  Int
-> Options
-> Builder
-> Builder
-> ((Text, Builder) -> Builder)
-> [(Text, Builder)]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'{') (Char -> Builder
Builder.char8 Char
'}') (Text, Builder) -> Builder
serx [(Text, Builder)]
obj
  where
    obj :: [(Text.Text, Builder.Builder)]
    obj :: [(Text, Builder)]
obj = Bool
-> (forall b. UnjsonDef b -> b -> Builder)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Builder)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Int -> Options -> UnjsonDef b -> b -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Options -> Int
indent Options
opt) Options
opt) a
a Ap (FieldDef a) (Result a)
f
    serx :: (Text.Text, Builder.Builder) -> Builder.Builder
    serx :: (Text, Builder) -> Builder
serx (Text
key,Builder
val) = ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
key)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
':'
                     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Options -> Bool
pretty Options
opt then Char -> Builder
Builder.char8 Char
' ' else Builder
forall a. Monoid a => a
mempty) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val
unjsonToByteStringBuilder'' Int
level Options
opt (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
f) a
a =
  Int
-> Options
-> Builder
-> Builder
-> (Builder -> Builder)
-> [Builder]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'[') (Char -> Builder
Builder.char8 Char
']') Builder -> Builder
forall a. a -> a
id ((forall b. UnjsonDef b -> b -> Builder)
-> a -> Ap (TupleFieldDef a) (Result a) -> [Builder]
forall v s a.
(forall b. UnjsonDef b -> b -> v)
-> s -> Ap (TupleFieldDef s) a -> [v]
tupleDefToArray (Int -> Options -> UnjsonDef b -> b -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
levelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Options -> Int
indent Options
opt) Options
opt) a
a Ap (TupleFieldDef a) (Result a)
f)
unjsonToByteStringBuilder'' Int
level Options
opt (DisjointUnjsonDef Text
k [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) a
a =
  Int
-> Options
-> Builder
-> Builder
-> ((Text, Builder) -> Builder)
-> [(Text, Builder)]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'{') (Char -> Builder
Builder.char8 Char
'}') (Text, Builder) -> Builder
serx [(Text, Builder)]
obj
  where
    obj :: [(Text.Text, Builder.Builder)]
    obj :: [(Text, Builder)]
obj = (Text
k,ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
nm))) (Text, Builder) -> [(Text, Builder)] -> [(Text, Builder)]
forall a. a -> [a] -> [a]
: Bool
-> (forall b. UnjsonDef b -> b -> Builder)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Builder)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Int -> Options -> UnjsonDef b -> b -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Options -> Int
indent Options
opt) Options
opt) a
a Ap (FieldDef a) (Result a)
f
    serx :: (Text.Text, Builder.Builder) -> Builder.Builder
    serx :: (Text, Builder) -> Builder
serx (Text
key,Builder
val) = ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
key)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
':'
                     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Options -> Bool
pretty Options
opt then Char -> Builder
Builder.char8 Char
' ' else Builder
forall a. Monoid a => a
mempty)  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val
    [(Text
nm,a -> Bool
_,Ap (FieldDef a) (Result a)
f)] = ((Text, a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
_,a -> Bool
is,Ap (FieldDef a) (Result a)
_) -> a -> Bool
is a
a) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l
unjsonToByteStringBuilder'' Int
level Options
opt (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
l) a
a =
  Int
-> Options
-> Builder
-> Builder
-> ((Text, Builder) -> Builder)
-> [(Text, Builder)]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'{') (Char -> Builder
Builder.char8 Char
'}') (Text, Builder) -> Builder
serx [(Text, Builder)]
obj
  where
    obj :: [(Text.Text, Builder.Builder)]
    obj :: [(Text, Builder)]
obj = Bool
-> (forall b. UnjsonDef b -> b -> Builder)
-> a
-> Ap (FieldDef a) (Result a)
-> [(Text, Builder)]
forall v s a.
Bool
-> (forall b. UnjsonDef b -> b -> v)
-> s
-> Ap (FieldDef s) a
-> [(Text, v)]
objectDefToArray (Options -> Bool
nulls Options
opt) (Int -> Options -> UnjsonDef b -> b -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Options -> Int
indent Options
opt) Options
opt) a
a Ap (FieldDef a) (Result a)
f
    serx :: (Text.Text, Builder.Builder) -> Builder.Builder
    serx :: (Text, Builder) -> Builder
serx (Text
key,Builder
val) = ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Text
key)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
':'
                     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Options -> Bool
pretty Options
opt then Char -> Builder
Builder.char8 Char
' ' else Builder
forall a. Monoid a => a
mempty)  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val
    [(a -> Bool
_,Ap (FieldDef a) (Result a)
f)] = ((a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a -> Bool
is,Ap (FieldDef a) (Result a)
_) -> a -> Bool
is a
a) [(a -> Bool, Ap (FieldDef a) (Result a))]
l
unjsonToByteStringBuilder'' Int
level Options
opt (MapUnjsonDef UnjsonDef k
f KeyMap k -> Result a
_ a -> KeyMap k
g) a
a =
  Int
-> Options
-> Builder
-> Builder
-> ((Key, Builder) -> Builder)
-> [(Key, Builder)]
-> Builder
forall a.
Int
-> Options
-> Builder
-> Builder
-> (a -> Builder)
-> [a]
-> Builder
unjsonGroup Int
level Options
opt (Char -> Builder
Builder.char8 Char
'{') (Char -> Builder
Builder.char8 Char
'}') (Key, Builder) -> Builder
serx [(Key, Builder)]
obj
  where
    obj :: [(Key, Builder)]
obj = KeyMap Builder -> [(Key, Builder)]
forall v. KeyMap v -> [(Key, v)]
AC.toList ((k -> Builder) -> KeyMap k -> KeyMap Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Options -> UnjsonDef k -> k -> Builder
forall a. Int -> Options -> UnjsonDef a -> a -> Builder
unjsonToByteStringBuilder'' (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Options -> Int
indent Options
opt) Options
opt UnjsonDef k
f) (a -> KeyMap k
g a
a))
    serx :: (Key, Builder) -> Builder
serx (Key
key,Builder
val) = ByteString -> Builder
Builder.lazyByteString (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Key -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON Key
key)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
':'
                     Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Options -> Bool
pretty Options
opt then Char -> Builder
Builder.char8 Char
' ' else Builder
forall a. Monoid a => a
mempty) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val

listRequiredKeysForField :: FieldDef s a -> [Text.Text]
listRequiredKeysForField :: FieldDef s a -> [Text]
listRequiredKeysForField (FieldReqDef Text
key Text
_docstring s -> a
_f UnjsonDef a
_d) = [Text
key]
listRequiredKeysForField (FieldOptDef Text
_key Text
_docstring s -> Maybe a
_f UnjsonDef a
_d) = []
listRequiredKeysForField (FieldDefDef Text
_key Text
_docstring a
_f s -> a
_ UnjsonDef a
_d) = []
listRequiredKeysForField (FieldRODef  Text
_key Text
_docstring s -> a
_f UnjsonDef a
_d) = []

listRequiredKeys :: Ap (FieldDef s) a -> [Text.Text]
listRequiredKeys :: Ap (FieldDef s) a -> [Text]
listRequiredKeys (Pure a
_) = []
listRequiredKeys (Ap FieldDef s a1
f Ap (FieldDef s) (a1 -> a)
r) =
  FieldDef s a1 -> [Text]
forall s a. FieldDef s a -> [Text]
listRequiredKeysForField FieldDef s a1
f [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Ap (FieldDef s) (a1 -> a) -> [Text]
forall s a. Ap (FieldDef s) a -> [Text]
listRequiredKeys Ap (FieldDef s) (a1 -> a)
r


-- | Count how many applications there are. Useful for error
-- reporting.
countAp :: Int -> Ap x a -> Int
countAp :: Int -> Ap x a -> Int
countAp !Int
n (Pure a
_) = Int
n
countAp Int
n (Ap x a1
_ Ap x (a1 -> a)
r) = Int -> Ap x (a1 -> a) -> Int
forall (x :: * -> *) a. Int -> Ap x a -> Int
countAp (Int -> Int
forall a. Enum a => a -> a
succ Int
n) Ap x (a1 -> a)
r

mapResultsIssuePaths :: (Path -> Path) -> Result a -> Result a
mapResultsIssuePaths :: (Path -> Path) -> Result a -> Result a
mapResultsIssuePaths Path -> Path
f (Result a
v Problems
paths) = a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
v' Problems
paths'
  where
    paths' :: Problems
paths' = (Problem -> Problem) -> Problems -> Problems
forall a b. (a -> b) -> [a] -> [b]
map Problem -> Problem
fa Problems
paths
    v' :: a
v' = (Problem -> Problem) -> a -> a
forall e1 e2 a.
(Exception e1, Exception e2) =>
(e1 -> e2) -> a -> a
mapException Problem -> Problem
fa a
v
    fa :: Problem -> Problem
fa (Anchored Path
path Text
x) = Path -> Text -> Problem
forall a. Path -> a -> Anchored a
Anchored (Path -> Path
f Path
path) Text
x

resultPrependIndex :: Int -> Result a -> Result a
resultPrependIndex :: Int -> Result a -> Result a
resultPrependIndex Int
i = (Path -> Path) -> Result a -> Result a
forall a. (Path -> Path) -> Result a -> Result a
mapResultsIssuePaths ([PathElem] -> Path
Path [Int -> PathElem
PathElemIndex Int
i]Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<>)

resultPrependKey :: Text.Text -> Result a -> Result a
resultPrependKey :: Text -> Result a -> Result a
resultPrependKey Text
k = (Path -> Path) -> Result a -> Result a
forall a. (Path -> Path) -> Result a -> Result a
mapResultsIssuePaths ([PathElem] -> Path
Path [Text -> PathElem
PathElemKey Text
k]Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<>)

parseUpdating :: UnjsonDef a -> Maybe a -> Aeson.Value -> Result a
parseUpdating :: UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating (SimpleUnjsonDef Text
_ Value -> Result a
f a -> Value
_) Maybe a
_ov Value
v = Value -> Result a
f Value
v
parseUpdating (ArrayUnjsonDef (Just (PrimaryKeyExtraction k -> pk
pk_from_object UnjsonDef pk
pk_from_json)) ArrayMode
m [k] -> Result a
g a -> [k]
k UnjsonDef k
f) (Just a
ov) Value
v
  = case (Value -> Parser (Vector Value))
-> Value -> Either String (Vector Value)
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser (Vector Value)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Vector Value
v' -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ ([k] -> Result a) -> Result [k] -> Result (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [k] -> Result a
g (Result [k] -> Result (Result a))
-> Result [k] -> Result (Result a)
forall a b. (a -> b) -> a -> b
$
        [Result k] -> Result [k]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((Value -> Int -> Result k) -> [Value] -> [Int] -> [Result k]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Value
v'' Int
i -> Value -> Result (Maybe k)
lookupObjectByJson Value
v'' Result (Maybe k) -> (Maybe k -> Result k) -> Result k
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe k
ov' -> (Int -> Result k -> Result k
forall a. Int -> Result a -> Result a
resultPrependIndex Int
i (Result k -> Result k) -> Result k -> Result k
forall a b. (a -> b) -> a -> b
$ UnjsonDef k -> Maybe k -> Value -> Result k
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef k
f Maybe k
ov' Value
v''))
                                    (Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
v') [Int
0..])
      Left String
e -> case ArrayMode
m of
          ArrayMode
ArrayModeStrict ->
            String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          ArrayMode
_ -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ ([k] -> Result a) -> Result [k] -> Result (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [k] -> Result a
g (Result [k] -> Result (Result a))
-> Result [k] -> Result (Result a)
forall a b. (a -> b) -> a -> b
$
            [Result k] -> Result [k]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Value -> Result (Maybe k)
lookupObjectByJson Value
v Result (Maybe k) -> (Maybe k -> Result k) -> Result k
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe k
ov' ->
                                        UnjsonDef k -> Maybe k -> Value -> Result k
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef k
f Maybe k
ov'
                                        Value
v]
  where
    -- Note: Map.fromList is right-biased, so that Map.fromList [(1,1),(1,2)] is [(1,2)]
    -- we need it to be left-biased, so we use Map.fromListWith (flip const)
    objectMap :: Map pk k
objectMap = (k -> k -> k) -> [(pk, k)] -> Map pk k
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((k -> k -> k) -> k -> k -> k
forall a b c. (a -> b -> c) -> b -> a -> c
flip k -> k -> k
forall a b. a -> b -> a
const) ((k -> (pk, k)) -> [k] -> [(pk, k)]
forall a b. (a -> b) -> [a] -> [b]
map (\k
o -> (k -> pk
pk_from_object k
o, k
o)) (a -> [k]
k a
ov))
    lookupObjectByJson :: Value -> Result (Maybe k)
lookupObjectByJson Value
js = UnjsonDef pk -> Maybe pk -> Value -> Result pk
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef pk
pk_from_json Maybe pk
forall a. Maybe a
Nothing Value
js Result pk -> (pk -> Result (Maybe k)) -> Result (Maybe k)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \pk
val -> Maybe k -> Result (Maybe k)
forall (m :: * -> *) a. Monad m => a -> m a
return (pk -> Map pk k -> Maybe k
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup pk
val Map pk k
objectMap)

parseUpdating (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
_ ArrayMode
m [k] -> Result a
g a -> [k]
_k UnjsonDef k
f) Maybe a
_ov Value
v
  = case (Value -> Parser (Vector Value))
-> Value -> Either String (Vector Value)
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser (Vector Value)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Vector Value
v' -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ ([k] -> Result a) -> Result [k] -> Result (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [k] -> Result a
g (Result [k] -> Result (Result a))
-> Result [k] -> Result (Result a)
forall a b. (a -> b) -> a -> b
$
        [Result k] -> Result [k]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((Value -> Int -> Result k) -> [Value] -> [Int] -> [Result k]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Value
v'' Int
i -> Int -> Result k -> Result k
forall a. Int -> Result a -> Result a
resultPrependIndex Int
i (Result k -> Result k) -> Result k -> Result k
forall a b. (a -> b) -> a -> b
$ UnjsonDef k -> Maybe k -> Value -> Result k
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef k
f Maybe k
forall a. Maybe a
Nothing Value
v'') (Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
v') [Int
0..])
      Left String
e -> case ArrayMode
m of
          ArrayMode
ArrayModeStrict ->
            String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          ArrayMode
_ -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ ([k] -> Result a) -> Result [k] -> Result (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [k] -> Result a
g (Result [k] -> Result (Result a))
-> Result [k] -> Result (Result a)
forall a b. (a -> b) -> a -> b
$
            [Result k] -> Result [k]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [UnjsonDef k -> Maybe k -> Value -> Result k
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef k
f Maybe k
forall a. Maybe a
Nothing Value
v]

parseUpdating (ObjectUnjsonDef Ap (FieldDef a) (Result a)
f) Maybe a
ov Value
v
  = case (Value -> Parser Object) -> Value -> Either String Object
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Object
v' ->
        Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((forall x. FieldDef a x -> Result x)
-> Ap (FieldDef a) (Result a) -> Result (Result a)
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Object -> Maybe a -> FieldDef a x -> Result x
forall s a. Object -> Maybe s -> FieldDef s a -> Result a
lookupByFieldDef Object
v' Maybe a
ov) Ap (FieldDef a) (Result a)
f)
      Left String
e ->
        String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e

parseUpdating (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
f) Maybe a
ov Value
v
  = case (Value -> Parser (Vector Value))
-> Value -> Either String (Vector Value)
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser (Vector Value)
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Vector Value
v' ->
        let r :: Result (Result a)
r@(Result Result a
g Problems
h) = (forall x. TupleFieldDef a x -> Result x)
-> Ap (TupleFieldDef a) (Result a) -> Result (Result a)
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Vector Value -> Maybe a -> TupleFieldDef a x -> Result x
forall s a.
Vector Value -> Maybe s -> TupleFieldDef s a -> Result a
lookupByTupleFieldDef Vector Value
v' Maybe a
ov) Ap (TupleFieldDef a) (Result a)
f
            tupleSize :: Int
tupleSize = Int -> Ap (TupleFieldDef a) (Result a) -> Int
forall (x :: * -> *) a. Int -> Ap x a -> Int
countAp Int
0 Ap (TupleFieldDef a) (Result a)
f
            arrayLength :: Int
arrayLength = Vector Value -> Int
forall a. Vector a -> Int
Vector.length Vector Value
v'
        in if Int
tupleSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arrayLength
             then Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Result (Result a)
r
             else Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ Result a -> Problems -> Result (Result a)
forall a. a -> Problems -> Result a
Result Result a
g ([Path -> Text -> Problem
forall a. Path -> a -> Anchored a
Anchored Path
forall a. Monoid a => a
mempty (Text
"cannot parse array of length " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
arrayLength) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                                 Text
" into tuple of size " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
tupleSize))] Problems -> Problems -> Problems
forall a. Semigroup a => a -> a -> a
<> Problems
h)
      Left String
e ->
        String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e

parseUpdating (DisjointUnjsonDef Text
k [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) Maybe a
ov Value
v
  = case (Value -> Parser Object) -> Value -> Either String Object
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Object
v' -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AC.lookup (Text -> Key
AC.fromText Text
k) Object
v' of
        Just Value
x -> case (Value -> Parser Text) -> Value -> Either String Text
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
x of
          Right Text
xx -> case ((Text, a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
nm,a -> Bool
_,Ap (FieldDef a) (Result a)
_) -> Text
nmText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
xx) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l of
            [(Text
_,a -> Bool
_,Ap (FieldDef a) (Result a)
f)] -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((forall x. FieldDef a x -> Result x)
-> Ap (FieldDef a) (Result a) -> Result (Result a)
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Object -> Maybe a -> FieldDef a x -> Result x
forall s a. Object -> Maybe s -> FieldDef s a -> Result a
lookupByFieldDef Object
v' Maybe a
ov) Ap (FieldDef a) (Result a)
f)
            [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
_ ->
              Text -> Result a -> Result a
forall a. Text -> Result a -> Result a
resultPrependKey Text
k (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ String
"value '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
xx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is not one of the allowed for enumeration [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((Text, a -> Bool, Ap (FieldDef a) (Result a)) -> String)
-> [(Text, a -> Bool, Ap (FieldDef a) (Result a))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,a -> Bool
_,Ap (FieldDef a) (Result a)
_) -> Text -> String
Text.unpack Text
a) [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
          Left String
e ->
            String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Maybe Value
Nothing -> case Maybe a
ov of
          Just a
xov -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
xov []
          Maybe a
Nothing -> Text -> Result a -> Result a
forall a. Text -> Result a -> Result a
resultPrependKey Text
k (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing key"
      Left String
e ->
        String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
parseUpdating (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
l) Maybe a
ov Value
v
  = case (Value -> Parser Object) -> Value -> Either String Object
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Object
v' -> case ((a -> Bool, Ap (FieldDef a) (Result a)) -> Bool)
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [(a -> Bool, Ap (FieldDef a) (Result a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a -> Bool
_,Ap (FieldDef a) (Result a)
f) -> Maybe () -> Bool
forall a. Maybe a -> Bool
isJust ((Text -> Maybe Value) -> [Text] -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Text
k -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AC.lookup (Text -> Key
AC.fromText Text
k) Object
v') (Ap (FieldDef a) (Result a) -> [Text]
forall s a. Ap (FieldDef s) a -> [Text]
listRequiredKeys Ap (FieldDef a) (Result a)
f))) [(a -> Bool, Ap (FieldDef a) (Result a))]
l of
        ((a -> Bool
_,Ap (FieldDef a) (Result a)
f):[(a -> Bool, Ap (FieldDef a) (Result a))]
_) -> Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((forall x. FieldDef a x -> Result x)
-> Ap (FieldDef a) (Result a) -> Result (Result a)
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (Object -> Maybe a -> FieldDef a x -> Result x
forall s a. Object -> Maybe s -> FieldDef s a -> Result a
lookupByFieldDef Object
v' Maybe a
ov) Ap (FieldDef a) (Result a)
f)
        [(a -> Bool, Ap (FieldDef a) (Result a))]
_ -> String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ String
"union value type could not be recognized based on presence of keys"
      Left String
e ->
        String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
parseUpdating (MapUnjsonDef UnjsonDef k
f KeyMap k -> Result a
g a -> KeyMap k
h) Maybe a
ov Value
v
  = case (Value -> Parser Object) -> Value -> Either String Object
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v of
      Right Object
v' ->
        let hov :: Maybe (KeyMap k)
hov = (a -> KeyMap k) -> Maybe a -> Maybe (KeyMap k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> KeyMap k
h Maybe a
ov in
        Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Result (Result a) -> Result a) -> Result (Result a) -> Result a
forall a b. (a -> b) -> a -> b
$ (KeyMap k -> Result a) -> Result (KeyMap k) -> Result (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyMap k -> Result a
g (Result (KeyMap k) -> Result (Result a))
-> Result (KeyMap k) -> Result (Result a)
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Result k) -> Object -> Result (KeyMap k)
forall (f :: * -> *) v1 v2.
Applicative f =>
(Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
AC.traverseWithKey (\Key
k1 Value
v1 -> Text -> Result k -> Result k
forall a. Text -> Result a -> Result a
resultPrependKey (Key -> Text
AC.toText Key
k1) (Result k -> Result k) -> Result k -> Result k
forall a b. (a -> b) -> a -> b
$ UnjsonDef k -> Maybe k -> Value -> Result k
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef k
f (Maybe (Maybe k) -> Maybe k
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((KeyMap k -> Maybe k) -> Maybe (KeyMap k) -> Maybe (Maybe k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key -> KeyMap k -> Maybe k
forall v. Key -> KeyMap v -> Maybe v
AC.lookup Key
k1) Maybe (KeyMap k)
hov)) Value
v1) Object
v'
      Left String
e ->
        String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e


-- | Parse JSON according to unjson definition.
--
-- Example:
--
-- > let json = Aeson.object [ ... ]
-- > let Result val iss = parse unjsonThing json
-- > if null iss
-- >   then putStrLn ("Parsed: " ++ show val)
-- >   else putStrLn ("Not parsed, issues: " ++ show iss)
--
-- Error reporting is a strong side of Unjson, see 'Result'.
--
-- For parsing of fields the following rules apply:
--
-- - required fields generate an error if json key is missing
--
-- - for optional fields Nothing is returned if json key is missing,
-- Just value otherwise
--
-- - for fields with default value, the default value is returned if
-- key is missing, otherwise the parsed value is returned
--
-- Note that Unjson makes strong difference between missing keys and
-- values that result in parse errors.
--
-- For discussion of update mode see 'update'.
parse :: UnjsonDef a -> Aeson.Value -> Result a
parse :: UnjsonDef a -> Value -> Result a
parse UnjsonDef a
vd = UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
vd Maybe a
forall a. Maybe a
Nothing

-- | Update object with JSON according to unjson definition.
--
-- Example:
--
-- > let original = Thing { ... }
-- > let json = Aeson.object [ ... ]
-- > let Result val iss = update original unjsonThing (Anchored [] json)
-- > if null iss
-- >   then putStrLn ("Updated: " ++ show val)
-- >   else putStrLn ("Not updated, issues: " ++ show iss)
--
-- Error reporting is a strong side of Unjson, see 'Result'.
--
-- For updating of fields the following rules apply:
--
-- - required fields take the original value if json key is missing
--
-- - optional fields take the original value if json key is missing
-- unless the value is @null@, then Nothing is returned (reset to
-- Nothing)
--
-- - fields with default value take the original value if json key is
-- missing unless the value is @null@, then the default value is
-- returned (reset to default)
--
-- Note that Unjson makes strong difference between missing keys and
-- values that result in parse errors.
--
-- For discussion of parse mode see 'parse'.
update :: a -> UnjsonDef a -> Aeson.Value -> Result a
update :: a -> UnjsonDef a -> Value -> Result a
update a
a UnjsonDef a
vd = UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
vd (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

lookupByFieldDef :: Aeson.Object -> Maybe s -> FieldDef s a -> Result a
lookupByFieldDef :: Object -> Maybe s -> FieldDef s a -> Result a
lookupByFieldDef Object
v Maybe s
ov (FieldReqDef Text
name Text
_docstring s -> a
f UnjsonDef a
valuedef)
  = Text -> Result a -> Result a
forall a. Text -> Result a -> Result a
resultPrependKey Text
name (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AC.lookup (Text -> Key
AC.fromText Text
name) Object
v of
      Just Value
x  -> UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
valuedef ((s -> a) -> Maybe s -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
f Maybe s
ov) Value
x
      Maybe Value
Nothing -> case Maybe s
ov of
                   Just s
xov -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result (s -> a
f s
xov) []
                   Maybe s
Nothing -> String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing key"
lookupByFieldDef Object
v Maybe s
ov (FieldDefDef Text
name Text
_docstring a
def s -> a
f UnjsonDef a
valuedef)
  = Text -> Result a -> Result a
forall a. Text -> Result a -> Result a
resultPrependKey Text
name (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AC.lookup (Text -> Key
AC.fromText Text
name) Object
v of
      Just Value
Aeson.Null -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
def []
      Just Value
x  -> UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
valuedef ((s -> a) -> Maybe s -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
f Maybe s
ov) Value
x
      Maybe Value
Nothing -> case Maybe s
ov of
                   Just s
xov -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result (s -> a
f s
xov) []
                   Maybe s
Nothing -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
def []
lookupByFieldDef Object
v Maybe s
ov (FieldOptDef Text
name Text
_docstring s -> Maybe a
f UnjsonDef a
valuedef)
  = Text -> Result (Maybe a) -> Result (Maybe a)
forall a. Text -> Result a -> Result a
resultPrependKey Text
name (Result (Maybe a) -> Result (Maybe a))
-> Result (Maybe a) -> Result (Maybe a)
forall a b. (a -> b) -> a -> b
$ case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AC.lookup (Text -> Key
AC.fromText Text
name) Object
v of
      Just Value
Aeson.Null -> Maybe a -> Problems -> Result (Maybe a)
forall a. a -> Problems -> Result a
Result Maybe a
forall a. Maybe a
Nothing []
      Just Value
x  -> case Maybe s
ov of
                   Just s
xov -> (a -> Maybe a) -> Result a -> Result (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
valuedef (s -> Maybe a
f s
xov) Value
x)
                   Maybe s
Nothing -> (a -> Maybe a) -> Result a -> Result (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
valuedef Maybe a
forall a. Maybe a
Nothing Value
x)
      Maybe Value
Nothing -> case Maybe s
ov of
                   Just s
xov -> Maybe a -> Problems -> Result (Maybe a)
forall a. a -> Problems -> Result a
Result (s -> Maybe a
f s
xov) []
                   Maybe s
Nothing -> Maybe a -> Problems -> Result (Maybe a)
forall a. a -> Problems -> Result a
Result Maybe a
forall a. Maybe a
Nothing []
lookupByFieldDef Object
_ Maybe s
_ (FieldRODef Text
_name Text
_docstring s -> a
_f UnjsonDef a
_valuedef) = () -> Problems -> Result ()
forall a. a -> Problems -> Result a
Result () []


lookupByTupleFieldDef :: Aeson.Array -> Maybe s -> TupleFieldDef s a -> Result a
lookupByTupleFieldDef :: Vector Value -> Maybe s -> TupleFieldDef s a -> Result a
lookupByTupleFieldDef Vector Value
v Maybe s
ov (TupleFieldDef Int
idx s -> a
f UnjsonDef a
valuedef)
  = Int -> Result a -> Result a
forall a. Int -> Result a -> Result a
resultPrependIndex Int
idx (Result a -> Result a) -> Result a -> Result a
forall a b. (a -> b) -> a -> b
$ case Vector Value
v Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
idx of
      Just Value
x  -> UnjsonDef a -> Maybe a -> Value -> Result a
forall a. UnjsonDef a -> Maybe a -> Value -> Result a
parseUpdating UnjsonDef a
valuedef ((s -> a) -> Maybe s -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> a
f Maybe s
ov) Value
x
      Maybe Value
Nothing -> String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing key"

-- | Declare a required field with definition given inline by valuedef.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> fieldBy "credentials"
-- >          thingCredentials
-- >          "Credentials to use"
-- >          unjsonCredentials
-- >
-- > data Thing = Thing { thingCredentials :: Credentials, ... }
-- > unjsonCredentials :: UnjsonDef Credentials
fieldBy :: Typeable a => Text.Text -> (s -> a) -> Text.Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldBy :: Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldBy Text
key s -> a
f Text
docstring UnjsonDef a
valuedef = FieldDef s a -> Ap (FieldDef s) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s a
forall a s.
Typeable a =>
Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s a
FieldReqDef Text
key Text
docstring s -> a
f UnjsonDef a
valuedef)

-- | Declare a required field with definition from 'Unjson' typeclass.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> field "credentials"
-- >          thingCredentials
-- >          "Credentials to use"
-- >
-- > data Thing = Thing { thingCredentials :: Credentials, ... }
-- > instance Unjson Credentials where ...
field :: (Unjson a, Typeable a) => Text.Text -> (s -> a) -> Text.Text -> Ap (FieldDef s) a
field :: Text -> (s -> a) -> Text -> Ap (FieldDef s) a
field Text
key s -> a
f Text
docstring = Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
forall a s.
Typeable a =>
Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldBy Text
key s -> a
f Text
docstring UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef

-- | Declare an optional field and definition by valuedef.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> fieldOptBy "credentials"
-- >          thingCredentials
-- >          "Optional credentials to use"
-- >          unjsonCredentials
-- >
-- > data Thing = Thing { thingCredentials :: Credentials, ... }
-- > unjsonCredentials :: UnjsonDef Credentials
fieldOptBy :: Typeable a => Text.Text -> (s -> Maybe a) -> Text.Text -> UnjsonDef a -> Ap (FieldDef s) (Maybe a)
fieldOptBy :: Text
-> (s -> Maybe a)
-> Text
-> UnjsonDef a
-> Ap (FieldDef s) (Maybe a)
fieldOptBy Text
key s -> Maybe a
f Text
docstring UnjsonDef a
valuedef = FieldDef s (Maybe a) -> Ap (FieldDef s) (Maybe a)
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Text
-> Text -> (s -> Maybe a) -> UnjsonDef a -> FieldDef s (Maybe a)
forall a s.
Typeable a =>
Text
-> Text -> (s -> Maybe a) -> UnjsonDef a -> FieldDef s (Maybe a)
FieldOptDef Text
key Text
docstring s -> Maybe a
f UnjsonDef a
valuedef)

-- | Declare an optional field and definition by 'Unjson' typeclass.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> fieldOpt "credentials"
-- >          thingCredentials
-- >          "Optional credentials to use"
-- >
-- > data Thing = Thing { thingCredentials :: Credentials, ... }
-- > instance Unjson Credentials where ...
fieldOpt :: (Unjson a, Typeable a) => Text.Text -> (s -> Maybe a) -> Text.Text -> Ap (FieldDef s) (Maybe a)
fieldOpt :: Text -> (s -> Maybe a) -> Text -> Ap (FieldDef s) (Maybe a)
fieldOpt Text
key s -> Maybe a
f Text
docstring = Text
-> (s -> Maybe a)
-> Text
-> UnjsonDef a
-> Ap (FieldDef s) (Maybe a)
forall a s.
Typeable a =>
Text
-> (s -> Maybe a)
-> Text
-> UnjsonDef a
-> Ap (FieldDef s) (Maybe a)
fieldOptBy Text
key s -> Maybe a
f Text
docstring UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef

-- | Declare a field with default value and definition by valuedef.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> fieldDefBy "credentials" defaultCredentials
-- >          thingCredentials
-- >          "Credentials to use, defaults to defaultCredentials"
-- >          unjsonCredentials
-- >
-- > data Thing = Thing { thingCredentials :: Credentials, ... }
-- > unjsonCredentials :: UnjsonDef Credentials
fieldDefBy :: Typeable a => Text.Text -> a -> (s -> a) -> Text.Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldDefBy :: Text -> a -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldDefBy Text
key a
def s -> a
f Text
docstring UnjsonDef a
valuedef = FieldDef s a -> Ap (FieldDef s) a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Text -> Text -> a -> (s -> a) -> UnjsonDef a -> FieldDef s a
forall a s.
Typeable a =>
Text -> Text -> a -> (s -> a) -> UnjsonDef a -> FieldDef s a
FieldDefDef Text
key Text
docstring a
def s -> a
f UnjsonDef a
valuedef)

-- | Declare a field with default value and definition by 'Unjson' typeclass.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    <*> fieldDef "port" 80
-- >          thingPort
-- >          "Port to listen on, defaults to 80"
-- >
-- > data Thing = Thing { thingPort :: Int, ... }
fieldDef :: (Unjson a, Typeable a) => Text.Text -> a -> (s -> a) -> Text.Text -> Ap (FieldDef s) a
fieldDef :: Text -> a -> (s -> a) -> Text -> Ap (FieldDef s) a
fieldDef Text
key a
def s -> a
f Text
docstring = Text -> a -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
forall a s.
Typeable a =>
Text -> a -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) a
fieldDefBy Text
key a
def s -> a
f Text
docstring UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef


-- | Declare a field that is readonly from the point of view of Haskell structures,
-- it will be serialized to JSON but never read from JSON.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure (\s -> Thing 59123 s)
-- >    <* fieldReadonly "port"
-- >          thingPort
-- >          "Random port the server is listening on"
-- >    <*> field "string"
-- >          thingString
-- >          "Additional string"
-- >
-- > data Thing = Thing { thingPort :: Int, thingString :: String, ... }
fieldReadonly :: (Unjson a, Typeable a) => Text.Text -> (s -> a) -> Text.Text ->  Ap (FieldDef s) ()
fieldReadonly :: Text -> (s -> a) -> Text -> Ap (FieldDef s) ()
fieldReadonly Text
key s -> a
f Text
docstring = Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) ()
forall a s.
Typeable a =>
Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) ()
fieldReadonlyBy Text
key s -> a
f Text
docstring UnjsonDef a
forall a. Unjson a => UnjsonDef a
unjsonDef

-- | Declare a field that is readonly from the point of view of Haskell structures,
-- it will be serialized to JSON but never read from JSON. Accepts
-- unjson parser as a parameter.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure (\s -> Thing 59123 s)
-- >    <* fieldReadonlyBy "port"
-- >          thingPort
-- >          "Random port the server is listening on"
-- >          unjsonPort
-- >    <*> field "string"
-- >          thingString
-- >          "Additional string"
-- >
-- > data Thing = Thing { thingPort :: Port, thingString :: String, ... }
fieldReadonlyBy :: Typeable a => Text.Text -> (s -> a) -> Text.Text -> UnjsonDef a -> Ap (FieldDef s) ()
fieldReadonlyBy :: Text -> (s -> a) -> Text -> UnjsonDef a -> Ap (FieldDef s) ()
fieldReadonlyBy Text
key s -> a
f Text
docstring UnjsonDef a
valuedef = FieldDef s () -> Ap (FieldDef s) ()
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s ()
forall a s.
Typeable a =>
Text -> Text -> (s -> a) -> UnjsonDef a -> FieldDef s ()
FieldRODef Text
key Text
docstring s -> a
f UnjsonDef a
valuedef)

-- | Declare an object as bidirectional mapping from JSON object to Haskell record and back.
--
-- Example:
--
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = objectOf $ pure Thing
-- >    ...field definitions go here
--
-- Use field functions to specify fields of an object: 'field',
-- 'fieldBy', 'fieldOpt', 'fieldOptBy',
-- 'fieldDef' or 'fieldDefBy'.
objectOf :: Ap (FieldDef a) a -> UnjsonDef a
objectOf :: Ap (FieldDef a) a -> UnjsonDef a
objectOf Ap (FieldDef a) a
fields = Ap (FieldDef a) (Result a) -> UnjsonDef a
forall k. Ap (FieldDef k) (Result k) -> UnjsonDef k
ObjectUnjsonDef ((a -> Result a) -> Ap (FieldDef a) a -> Ap (FieldDef a) (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ap (FieldDef a) a
fields)


-- | Gather all keys with respective values in a map.
--
-- Example:
--
-- > data X = X { xMap :: LazyHashMap.HashMap Text.Text x }
-- >
-- > objectOf $ pure X
-- >   <*> fieldBy "xmap" xMap
-- >       "Map string to Y value"
-- >       (mapOf unjsonY)
--
-- Note that overloading allows for automatic conversion to more map
-- types, for example:
--
-- > data X = X { xMap :: Map.Map String x }
-- >
-- > objectOf $ pure X
-- >   <*> field "xmap" xMap
-- >       "Map string to Y value"
mapOf :: Typeable x => UnjsonDef x -> UnjsonDef (AC.LazyKeyMap x)
mapOf :: UnjsonDef x -> UnjsonDef (LazyKeyMap x)
mapOf UnjsonDef x
def = UnjsonDef x
-> (LazyKeyMap x -> Result (LazyKeyMap x))
-> (LazyKeyMap x -> LazyKeyMap x)
-> UnjsonDef (LazyKeyMap x)
forall k v.
Typeable k =>
UnjsonDef k
-> (KeyMap k -> Result v) -> (v -> KeyMap k) -> UnjsonDef v
MapUnjsonDef UnjsonDef x
def LazyKeyMap x -> Result (LazyKeyMap x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LazyKeyMap x -> LazyKeyMap x
forall a. a -> a
id

-- | Provide sum type support. Bidirectional case matching in Haskell
-- is not good, so some obvious information needs to be given
-- manually.
--
-- For related functionality see 'enumOf'.
--
-- Example:
--
-- > data X = A { aString :: String } | B { bInt :: Int }
-- >             deriving (Data,Typeable)
-- >
-- > unjsonX = disjointUnionOf "type"
-- >             [("a_thing", unjsonIsConstrByName "A",
-- >               pure A <*> field "string" "A string value"),
-- >              ("b_thing", unjsonIsConstrByName "B",
-- >               pure B <*> field "string" "An int value")]
--
-- Note that each case in the list must be able to discriminate between
-- constructors in a data type and it has to be able to this both
-- ways: to find out based on json contents which constructor applies
-- and also based on data contructor which of serialization cases to
-- use.
--
-- Note that 'unjsonIsConstrByName' is helpful, but you may use usual
-- @case ... of@ if you do not like the 'Data.Data.Data' typeclass.
disjointUnionOf :: Text.Text -> [(Text.Text, k -> Bool, Ap (FieldDef k) k)] -> UnjsonDef k
disjointUnionOf :: Text -> [(Text, k -> Bool, Ap (FieldDef k) k)] -> UnjsonDef k
disjointUnionOf Text
key [(Text, k -> Bool, Ap (FieldDef k) k)]
alternates =
  Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
forall k.
Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
DisjointUnjsonDef Text
key (((Text, k -> Bool, Ap (FieldDef k) k)
 -> (Text, k -> Bool, Ap (FieldDef k) (Result k)))
-> [(Text, k -> Bool, Ap (FieldDef k) k)]
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,k -> Bool
b,Ap (FieldDef k) k
c) -> (Text
a,k -> Bool
b,(k -> Result k) -> Ap (FieldDef k) k -> Ap (FieldDef k) (Result k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> Result k
forall (m :: * -> *) a. Monad m => a -> m a
return Ap (FieldDef k) k
c)) [(Text, k -> Bool, Ap (FieldDef k) k)]
alternates)

-- | Provide sum type support, non-disjoin version. Bidirectional case matching in Haskell
-- is not good, so some obvious information needs to be given
-- manually.
--
-- For related functionality see 'enumOf'.
--
-- Example:
--
-- > data X = A { aString :: String } | B { bInt :: Int }
-- >             deriving (Data,Typeable)
-- >
-- > unjsonX = unionOf
-- >             [(unjsonIsConstrByName "A",
-- >               pure A <*> field "string" "A string value"),
-- >              (unjsonIsConstrByName "B",
-- >               pure B <*> field "int" "An int value")]
--
-- Note that each case in the list must be able to discriminate between
-- constructors in a data type and it has to be able to this both
-- ways: to find out based on json contents which constructor applies
-- and also based on data contructor which of serialization cases to
-- use. To know what constructor to use at parsing time unjson looks
-- at fields present in json object and on list of field names
-- required to satisfy. First constructor for which all fields are
-- present is chosen.
--
-- Note that 'unjsonIsConstrByName' is helpful, but you may use usual
-- @case ... of@ if you do not like the 'Data.Data.Data' typeclass.
unionOf :: [(k -> Bool, Ap (FieldDef k) k)] -> UnjsonDef k
unionOf :: [(k -> Bool, Ap (FieldDef k) k)] -> UnjsonDef k
unionOf [(k -> Bool, Ap (FieldDef k) k)]
alternates =
  [(k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
forall k. [(k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
UnionUnjsonDef (((k -> Bool, Ap (FieldDef k) k)
 -> (k -> Bool, Ap (FieldDef k) (Result k)))
-> [(k -> Bool, Ap (FieldDef k) k)]
-> [(k -> Bool, Ap (FieldDef k) (Result k))]
forall a b. (a -> b) -> [a] -> [b]
map (\(k -> Bool
b,Ap (FieldDef k) k
c) -> (k -> Bool
b,(k -> Result k) -> Ap (FieldDef k) k -> Ap (FieldDef k) (Result k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> Result k
forall (m :: * -> *) a. Monad m => a -> m a
return Ap (FieldDef k) k
c)) [(k -> Bool, Ap (FieldDef k) k)]
alternates)

-- | Provide sum type support for parameterless constructors.
--
-- For related functionality see 'disjointUnionOf'.
--
-- Example:
--
-- > data X = A | B
-- >
-- > unjsonX = enumOf "type_thing"
-- >             [("a_thing", A),
-- >              ("b_thing", B)]
--
enumOf :: (Eq k) => Text.Text -> [(Text.Text, k)] -> UnjsonDef k
enumOf :: Text -> [(Text, k)] -> UnjsonDef k
enumOf Text
key [(Text, k)]
alternates =
  Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
forall k.
Text
-> [(Text, k -> Bool, Ap (FieldDef k) (Result k))] -> UnjsonDef k
DisjointUnjsonDef Text
key (((Text, k) -> (Text, k -> Bool, Ap (FieldDef k) (Result k)))
-> [(Text, k)] -> [(Text, k -> Bool, Ap (FieldDef k) (Result k))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,k
b) -> (Text
a,k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==)k
b,(k -> Result k) -> Ap (FieldDef k) k -> Ap (FieldDef k) (Result k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> Result k
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> Ap (FieldDef k) k
forall (f :: * -> *) a. Applicative f => a -> f a
pure k
b))) [(Text, k)]
alternates)

-- | Automatic sum type conversion with parameterless constructors.
--
-- Basically an automatic version of 'enumOf'.
--
-- Example:
--
-- > data X = A | B deriving (Eq, Data, Enum, Bounded)
-- >
-- > instance Unjson X where unjsonDef = enumUnjsonDef
--
enumUnjsonDef
  :: forall a. (Eq a, Typeable a, Enum a, Bounded a, Data a)
  => UnjsonDef a
enumUnjsonDef :: UnjsonDef a
enumUnjsonDef = Text -> [(Text, a)] -> UnjsonDef a
forall k. Eq k => Text -> [(Text, k)] -> UnjsonDef k
enumOf Text
typeName [ (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Constr -> String
forall a. Show a => a -> String
show (Constr -> String) -> Constr -> String
forall a b. (a -> b) -> a -> b
$ a -> Constr
forall a. Data a => a -> Constr
toConstr a
c, a
c) | a
c <- [a]
constructors ]
  where
    typeName :: Text
typeName = String -> Text
Text.pack (String -> Text) -> (Proxy a -> String) -> Proxy a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (Proxy a -> TypeRep) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> Text) -> Proxy a -> Text
forall a b. (a -> b) -> a -> b
$ (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    constructors :: [a]
constructors = a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
forall a. Bounded a => a
minBound a
forall a. Bounded a => a
maxBound :: [a]

-- | Declare array of values where each of them is described by
-- valuedef. Use 'unjsonAeson' to parse.
--
-- Example:
--
-- > unjsonArrayOfThings :: UnjsonDef [Thing]
-- > unjsonArrayOfThings = arrayOf unjsonThing
-- >
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = ...
arrayOf :: Typeable a => UnjsonDef a -> UnjsonDef [a]
arrayOf :: UnjsonDef a -> UnjsonDef [a]
arrayOf = ArrayMode -> UnjsonDef a -> UnjsonDef [a]
forall a. Typeable a => ArrayMode -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeOf ArrayMode
ArrayModeStrict

-- | Declare array of values where each of them is described by
-- valuedef. Accepts mode specifier.
--
-- Example:
--
-- > unjsonArrayOfThings :: UnjsonDef [Thing]
-- > unjsonArrayOfThings = arrayOf unjsonThing
-- >
-- > unjsonThing :: UnjsonDef Thing
-- > unjsonThing = ...
arrayWithModeOf :: Typeable a => ArrayMode -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeOf :: ArrayMode -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeOf ArrayMode
mode UnjsonDef a
valuedef = Maybe (PrimaryKeyExtraction a)
-> ArrayMode
-> ([a] -> Result [a])
-> ([a] -> [a])
-> UnjsonDef a
-> UnjsonDef [a]
forall k v.
Typeable k =>
Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result v)
-> (v -> [k])
-> UnjsonDef k
-> UnjsonDef v
ArrayUnjsonDef Maybe (PrimaryKeyExtraction a)
forall a. Maybe a
Nothing ArrayMode
mode [a] -> Result [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
forall a. a -> a
id UnjsonDef a
valuedef

-- | Declare array of primitive values lifed from 'Aeson'. Accepts
-- mode specifier.
--
-- @since 0.15.1.0
--
-- Example:
--
-- > unjsonArrayOfIntOrSimpleInt :: UnjsonDef [Int]
-- > unjsonArrayOfIntOrSimpleInt = arrayWithModeOf'
arrayWithModeOf' :: (Aeson.FromJSON a,Aeson.ToJSON a, Typeable a)
                 => ArrayMode
                 -> UnjsonDef [a]
arrayWithModeOf' :: ArrayMode -> UnjsonDef [a]
arrayWithModeOf' ArrayMode
mode = ArrayMode -> UnjsonDef a -> UnjsonDef [a]
forall a. Typeable a => ArrayMode -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeOf ArrayMode
mode UnjsonDef a
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson


-- | Declare array of objects with given parsers that should be
-- matched by a primary key and accepts mode specifier.
--
-- For discussion of primary key see 'arrayWithPrimaryKeyOf'. For
-- discussion of array modes see 'ArrayMode'.
--
-- Example:
--
-- > unjsonArrayOfIntToInt :: UnjsonDef [(Int,Int)]
-- > unjsonArrayOfIntToInt = arrayWithPrimaryKeyOf ArrayModeParseSingle
-- >                              (fst)
-- >                              (objectOf $ pure id
-- >                                 <*> field "key" id "Key in mapping")
-- >                              (objectOf $ pure (,)
-- >                                 <*> field "key" fst "Key in mapping"
-- >                                 <*> field "value" fst "Value in mapping")
arrayWithModeAndPrimaryKeyOf :: (Ord pk, Typeable a)
                             => ArrayMode
                             -> (a -> pk)
                             -> UnjsonDef pk
                             -> UnjsonDef a
                             -> UnjsonDef [a]
arrayWithModeAndPrimaryKeyOf :: ArrayMode
-> (a -> pk) -> UnjsonDef pk -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeAndPrimaryKeyOf ArrayMode
mode a -> pk
pk1 UnjsonDef pk
pk2 UnjsonDef a
valuedef =
  Maybe (PrimaryKeyExtraction a)
-> ArrayMode
-> ([a] -> Result [a])
-> ([a] -> [a])
-> UnjsonDef a
-> UnjsonDef [a]
forall k v.
Typeable k =>
Maybe (PrimaryKeyExtraction k)
-> ArrayMode
-> ([k] -> Result v)
-> (v -> [k])
-> UnjsonDef k
-> UnjsonDef v
ArrayUnjsonDef (PrimaryKeyExtraction a -> Maybe (PrimaryKeyExtraction a)
forall a. a -> Maybe a
Just ((a -> pk) -> UnjsonDef pk -> PrimaryKeyExtraction a
forall k pk.
Ord pk =>
(k -> pk) -> UnjsonDef pk -> PrimaryKeyExtraction k
PrimaryKeyExtraction a -> pk
pk1 UnjsonDef pk
pk2)) ArrayMode
mode [a] -> Result [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a] -> [a]
forall a. a -> a
id UnjsonDef a
valuedef

-- | Declare array of objects with given parsers that should be
-- matched by a primary key. Uses 'ArrayModeStrict'.
--
-- Primary key:
--
-- Primary keys are used to match objects in 'update' mode. When a
-- request to update array is issued and array has primary key
-- specification then the following steps are used:
--
-- 1. primary keys from old array elements are extracted and a mapping
--   from primary key to element is created. Mapping is left biased
--   meaning that first element with specific primary key in array is
--   used
--
-- 2. for each object in json array primary key is extracted and is
--   looked up in old elements mapping
--
-- 3. if mapping is found then element is 'update'd, if mapping is not
--   found then element is 'parse'd
--
-- 4. in all cases the order of elements in the *new* array is respected
--
-- Example:
--
-- > unjsonArrayOfIntToInt :: UnjsonDef [(Int,Int)]
-- > unjsonArrayOfIntToInt = arrayWithPrimaryKeyOf
-- >                              (fst)
-- >                              (objectOf $ pure id
-- >                                 <*> field "key" id "Key in mapping")
-- >                              (objectOf $ pure (,)
-- >                                 <*> field "key" fst "Key in mapping"
-- >                                 <*> field "value" fst "Value in mapping")
arrayWithPrimaryKeyOf :: (Ord pk, Typeable a)
                      => (a -> pk)
                      -> UnjsonDef pk
                      -> UnjsonDef a
                      -> UnjsonDef [a]
arrayWithPrimaryKeyOf :: (a -> pk) -> UnjsonDef pk -> UnjsonDef a -> UnjsonDef [a]
arrayWithPrimaryKeyOf a -> pk
pk1 UnjsonDef pk
pk2 UnjsonDef a
valuedef =
  ArrayMode
-> (a -> pk) -> UnjsonDef pk -> UnjsonDef a -> UnjsonDef [a]
forall pk a.
(Ord pk, Typeable a) =>
ArrayMode
-> (a -> pk) -> UnjsonDef pk -> UnjsonDef a -> UnjsonDef [a]
arrayWithModeAndPrimaryKeyOf ArrayMode
ArrayModeStrict a -> pk
pk1 UnjsonDef pk
pk2 UnjsonDef a
valuedef

-- | Use 'Aeson.fromJSON' and 'Aeson.toJSON' to create a
-- 'UnjsonDef'. This function is useful when lifted type is one of the
-- primitives. Although it can be used to lift user defined instances,
-- it is not advisable as there is too much information lost in the
-- process and proper error infomation is not possible. Use full
-- 'UnjsonDef' instance whenever possible.
--
-- Example:
--
-- > instance FromJSON MyType where ...
-- > instance ToJSON MyType where ...
-- > instance Unjson MyType where
-- >     unjsonDef = unjsonAeson
unjsonAeson :: forall a . (Aeson.FromJSON a,Aeson.ToJSON a, Typeable a) => UnjsonDef a
unjsonAeson :: UnjsonDef a
unjsonAeson = UnjsonDef a
forall a. (FromJSON a, ToJSON a, Typeable a) => UnjsonDef a
unjsonAesonFixCharArrayToString

-- | Like 'unjsonAeson' but accepts docstring as additional parameter
-- that should identify type.
unjsonAesonWithDoc :: (Aeson.FromJSON a,Aeson.ToJSON a) => Text.Text -> UnjsonDef a
unjsonAesonWithDoc :: Text -> UnjsonDef a
unjsonAesonWithDoc Text
docstring = Text -> (Value -> Result a) -> (a -> Value) -> UnjsonDef a
forall k.
Text -> (Value -> Result k) -> (k -> Value) -> UnjsonDef k
SimpleUnjsonDef Text
docstring
              (\Value
value ->
                case Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
value of
                  Aeson.Success a
result -> a -> Problems -> Result a
forall a. a -> Problems -> Result a
Result a
result []
                  Aeson.Error String
message -> String -> Result a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
message)
              a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON

-- | Rename @[Char]@ to @String@ everywhere.
unjsonAesonFixCharArrayToString :: forall a . (Aeson.FromJSON a,Aeson.ToJSON a, Typeable a) => UnjsonDef a
unjsonAesonFixCharArrayToString :: UnjsonDef a
unjsonAesonFixCharArrayToString =
  Text -> UnjsonDef a
forall a. (FromJSON a, ToJSON a) => Text -> UnjsonDef a
unjsonAesonWithDoc (String -> Text
Text.pack String
typeNameFixed)
  where
    typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a))
    typeNameFixed :: String
typeNameFixed = ShowS
fixup String
typeName
    fixup :: ShowS
fixup [] = []
    fixup (Char
'[':Char
'C':Char
'h':Char
'a':Char
'r':Char
']':String
rest) = String
"String" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
fixup String
rest
    fixup (Char
x:String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fixup String
xs

-- | Useful in 'DisjointUnjsonDef' as second element in tuples list to
-- check out if constructor is matching.
--
-- Example:
--
-- > data X = A | B | C
-- > unjsonIsConstrByName "B" B => True
unjsonIsConstrByName :: (Data a) => String -> a -> Bool
unjsonIsConstrByName :: String -> a -> Bool
unjsonIsConstrByName String
nm a
v = String
nm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Constr -> String
forall a. Show a => a -> String
show (a -> Constr
forall a. Data a => a -> Constr
toConstr a
v)

-- | Renders documentation for a parser into a multiline string. It is
-- expected that this string is a human readable representation that
-- can go directly to console.
--
-- Example rendering:
--
-- > hostname (req):
-- >     The hostname this service is visible as
-- >     Text
-- > port (def):
-- >     Port to listen on, defaults to 80
-- >     Int
-- > credentials (req):
-- >     User admin credentials
-- >     username (req):
-- >         Name of the user
-- >         Text
-- >     password (req):
-- >         Password for the user
-- >         Text
-- >     domain (opt):
-- >         Domain for user credentials
-- >         Text
-- > comment (opt):
-- >     Optional comment, free text
-- >     Text
-- > options (def):
-- >     Additional options, defaults to empty
-- >     array of:
-- >         Text
-- > alternates (opt):
-- >     Alternate names for this server
-- >     tuple of size 2 with elements:
-- >     0:
-- >         Text
-- >     1:
-- >         username (req):
-- >             Name of the user
-- >             Text
-- >         password (req):
-- >             Password for the user
-- >             Text
-- >         domain (opt):
-- >             Domain for user credentials
-- >             Text
render :: UnjsonDef a -> String
render :: UnjsonDef a -> String
render = Doc -> String
P.render (Doc -> String) -> (UnjsonDef a -> Doc) -> UnjsonDef a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc

-- | Render only selected part of structure documentation. Path should
-- point to a subtree, if it does not then Nothing is returned.
renderForPath :: (MonadFail m) => Path -> UnjsonDef a -> m String
renderForPath :: Path -> UnjsonDef a -> m String
renderForPath Path
path UnjsonDef a
def = (Doc -> String) -> m Doc -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> String
P.render (Path -> UnjsonDef a -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
renderDocForPath Path
path UnjsonDef a
def)

-- | Renders documentation for a parser into a 'P.Doc'. See 'render'
-- for example.
renderDoc :: UnjsonDef a -> P.Doc
renderDoc :: UnjsonDef a -> Doc
renderDoc (SimpleUnjsonDef Text
doc Value -> Result a
_ a -> Value
_) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
doc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset)
renderDoc (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
_ ArrayMode
_m [k] -> Result a
_g a -> [k]
_k UnjsonDef k
f) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"array of" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") Doc -> Doc -> Doc
P.$+$
             Int -> Doc -> Doc
P.nest Int
4 (UnjsonDef k -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef k
f)
renderDoc (MapUnjsonDef UnjsonDef k
f KeyMap k -> Result a
_ a -> KeyMap k
_) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"map of" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") Doc -> Doc -> Doc
P.$+$
             Int -> Doc -> Doc
P.nest Int
4 (UnjsonDef k -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef k
f)
renderDoc (ObjectUnjsonDef Ap (FieldDef a) (Result a)
f) =
             [Doc] -> Doc
P.vcat (Ap (FieldDef a) (Result a) -> [Doc]
forall s a. Ap (FieldDef s) a -> [Doc]
renderFields Ap (FieldDef a) (Result a)
f)
renderDoc (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
f) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"tuple of size " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int -> Ap (TupleFieldDef a) (Result a) -> Int
forall (x :: * -> *) a. Int -> Ap x a -> Int
countAp Int
0 Ap (TupleFieldDef a) (Result a)
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with elements:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.$+$
             [Doc] -> Doc
P.vcat (Ap (TupleFieldDef a) (Result a) -> [Doc]
forall s a. Ap (TupleFieldDef s) a -> [Doc]
renderTupleFields Ap (TupleFieldDef a) (Result a)
f)
renderDoc (DisjointUnjsonDef Text
k [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
z) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"disjoint union based on key:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.$+$
  [Doc] -> Doc
P.vcat [String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 ([Doc] -> Doc
P.vcat (Ap (FieldDef a) (Result a) -> [Doc]
forall s a. Ap (FieldDef s) a -> [Doc]
renderFields Ap (FieldDef a) (Result a)
f)) | (Text
l,a -> Bool
_,Ap (FieldDef a) (Result a)
f) <- [(Text, a -> Bool, Ap (FieldDef a) (Result a))]
z]
renderDoc (UnionUnjsonDef [(a -> Bool, Ap (FieldDef a) (Result a))]
z) = String -> Doc
P.text (String
ansiDimmed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"plain union based on presence of required keys:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.$+$
  [Doc] -> Doc
P.vcat [String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
i::Int) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 ([Doc] -> Doc
P.vcat (Ap (FieldDef a) (Result a) -> [Doc]
forall s a. Ap (FieldDef s) a -> [Doc]
renderFields Ap (FieldDef a) (Result a)
f)) | ((a -> Bool
_,Ap (FieldDef a) (Result a)
f),Int
i) <- [(a -> Bool, Ap (FieldDef a) (Result a))]
-> [Int] -> [((a -> Bool, Ap (FieldDef a) (Result a)), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a -> Bool, Ap (FieldDef a) (Result a))]
z [Int
1..]]

-- | Render only selected part of structure documentation as
-- 'P.Doc'. Path should point to a subtree, if it does not then
-- Nothing is returned.
renderDocForPath :: (MonadFail m) => Path -> UnjsonDef a -> m P.Doc
renderDocForPath :: Path -> UnjsonDef a -> m Doc
renderDocForPath Path
path UnjsonDef a
def = Path -> UnjsonDef a -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a
def


renderField :: FieldDef s a -> P.Doc
renderField :: FieldDef s a -> Doc
renderField (FieldReqDef Text
key Text
docstring s -> a
_f UnjsonDef a
d) =
  String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.<> String -> Doc
P.text String
" (req):" Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 (String -> Doc
P.text (Text -> String
Text.unpack Text
docstring) Doc -> Doc -> Doc
P.$+$ UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
d)
renderField (FieldOptDef Text
key Text
docstring s -> Maybe a
_f UnjsonDef a
d) =
  String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.<> String -> Doc
P.text String
" (opt):" Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 (String -> Doc
P.text (Text -> String
Text.unpack Text
docstring) Doc -> Doc -> Doc
P.$+$ UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
d)
renderField (FieldDefDef Text
key Text
docstring a
_f s -> a
_ UnjsonDef a
d) =
  String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.<> String -> Doc
P.text String
" (def):" Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 (String -> Doc
P.text (Text -> String
Text.unpack Text
docstring) Doc -> Doc -> Doc
P.$+$ UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
d)
renderField (FieldRODef Text
key Text
docstring s -> a
_f UnjsonDef a
d) =
  String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.<> String -> Doc
P.text String
" (ro):" Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 (String -> Doc
P.text (Text -> String
Text.unpack Text
docstring) Doc -> Doc -> Doc
P.$+$ UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
d)

renderFields :: Ap (FieldDef s) a -> [P.Doc]
renderFields :: Ap (FieldDef s) a -> [Doc]
renderFields (Pure a
_) = []
renderFields (Ap FieldDef s a1
f Ap (FieldDef s) (a1 -> a)
r) =
  FieldDef s a1 -> Doc
forall s a. FieldDef s a -> Doc
renderField FieldDef s a1
f Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Ap (FieldDef s) (a1 -> a) -> [Doc]
forall s a. Ap (FieldDef s) a -> [Doc]
renderFields Ap (FieldDef s) (a1 -> a)
r

renderTupleFields :: Ap (TupleFieldDef s) a -> [P.Doc]
renderTupleFields :: Ap (TupleFieldDef s) a -> [Doc]
renderTupleFields (Pure a
_) = []
renderTupleFields (Ap TupleFieldDef s a1
f Ap (TupleFieldDef s) (a1 -> a)
r) =
  TupleFieldDef s a1 -> Doc
forall s a. TupleFieldDef s a -> Doc
renderTupleField TupleFieldDef s a1
f Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Ap (TupleFieldDef s) (a1 -> a) -> [Doc]
forall s a. Ap (TupleFieldDef s) a -> [Doc]
renderTupleFields Ap (TupleFieldDef s) (a1 -> a)
r

renderTupleField :: TupleFieldDef s a -> P.Doc
renderTupleField :: TupleFieldDef s a -> Doc
renderTupleField (TupleFieldDef Int
index s -> a
_f UnjsonDef a
d) =
  String -> Doc
P.text (String
ansiBold String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ansiReset) Doc -> Doc -> Doc
P.<> String -> Doc
P.text String
":" Doc -> Doc -> Doc
P.$+$ Int -> Doc -> Doc
P.nest Int
4 Doc
s
  where
    s :: Doc
s = UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
d

findNestedUnjson :: (MonadFail m) => Path -> UnjsonDef a -> m P.Doc
findNestedUnjson :: Path -> UnjsonDef a -> m Doc
findNestedUnjson (Path []) UnjsonDef a
u = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (UnjsonDef a -> Doc
forall a. UnjsonDef a -> Doc
renderDoc UnjsonDef a
u)
findNestedUnjson (Path (PathElemIndex Int
n : [PathElem]
rest)) (TupleUnjsonDef Ap (TupleFieldDef a) (Result a)
d) = Int -> Path -> Ap (TupleFieldDef a) (Result a) -> m Doc
forall (m :: * -> *) s a.
MonadFail m =>
Int -> Path -> Ap (TupleFieldDef s) a -> m Doc
findNestedTupleUnjson Int
n ([PathElem] -> Path
Path [PathElem]
rest) Ap (TupleFieldDef a) (Result a)
d
findNestedUnjson (Path (PathElemIndex Int
_ : [PathElem]
rest)) (ArrayUnjsonDef Maybe (PrimaryKeyExtraction k)
_ ArrayMode
_ [k] -> Result a
_ a -> [k]
_ UnjsonDef k
d) = Path -> UnjsonDef k -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson ([PathElem] -> Path
Path [PathElem]
rest) UnjsonDef k
d
findNestedUnjson (Path (PathElemKey Text
k : [PathElem]
rest)) (ObjectUnjsonDef Ap (FieldDef a) (Result a)
d) = Text -> Path -> Ap (FieldDef a) (Result a) -> m Doc
forall (m :: * -> *) s a.
MonadFail m =>
Text -> Path -> Ap (FieldDef s) a -> m Doc
findNestedFieldUnjson Text
k ([PathElem] -> Path
Path [PathElem]
rest) Ap (FieldDef a) (Result a)
d
findNestedUnjson Path
_ UnjsonDef a
_ = String -> m Doc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot find crap"

findNestedTupleUnjson :: (MonadFail m) => Int -> Path -> Ap (TupleFieldDef s) a -> m P.Doc
findNestedTupleUnjson :: Int -> Path -> Ap (TupleFieldDef s) a -> m Doc
findNestedTupleUnjson Int
n Path
path (Ap (TupleFieldDef Int
index s -> a1
_f UnjsonDef a1
d) Ap (TupleFieldDef s) (a1 -> a)
_r) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
index = Path -> UnjsonDef a1 -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a1
d
findNestedTupleUnjson Int
n Path
path (Ap (TupleFieldDef Int
_index s -> a1
_f UnjsonDef a1
_d) Ap (TupleFieldDef s) (a1 -> a)
r) =
  Int -> Path -> Ap (TupleFieldDef s) (a1 -> a) -> m Doc
forall (m :: * -> *) s a.
MonadFail m =>
Int -> Path -> Ap (TupleFieldDef s) a -> m Doc
findNestedTupleUnjson Int
n Path
path Ap (TupleFieldDef s) (a1 -> a)
r
findNestedTupleUnjson Int
_ Path
_ Ap (TupleFieldDef s) a
_ = String -> m Doc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"findNestedTupleUnjson"

findNestedFieldUnjson :: (MonadFail m) => Text.Text -> Path -> Ap (FieldDef s) a -> m P.Doc
findNestedFieldUnjson :: Text -> Path -> Ap (FieldDef s) a -> m Doc
findNestedFieldUnjson Text
key (Path []) (Ap f :: FieldDef s a1
f@(FieldReqDef Text
k Text
_ s -> a1
_ UnjsonDef a1
_d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldDef s a1 -> Doc
forall s a. FieldDef s a -> Doc
renderField FieldDef s a1
f)
findNestedFieldUnjson Text
key (Path []) (Ap f :: FieldDef s a1
f@(FieldOptDef Text
k Text
_ s -> Maybe a
_ UnjsonDef a
_d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldDef s a1 -> Doc
forall s a. FieldDef s a -> Doc
renderField FieldDef s a1
f)
findNestedFieldUnjson Text
key (Path []) (Ap f :: FieldDef s a1
f@(FieldDefDef Text
k Text
_ a1
_ s -> a1
_ UnjsonDef a1
_d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldDef s a1 -> Doc
forall s a. FieldDef s a -> Doc
renderField FieldDef s a1
f)
findNestedFieldUnjson Text
key (Path []) (Ap f :: FieldDef s a1
f@(FieldRODef Text
k Text
_ s -> a
_ UnjsonDef a
_d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldDef s a1 -> Doc
forall s a. FieldDef s a -> Doc
renderField FieldDef s a1
f)
findNestedFieldUnjson Text
key Path
path (Ap (FieldReqDef Text
k Text
_ s -> a1
_ UnjsonDef a1
d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Path -> UnjsonDef a1 -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a1
d
findNestedFieldUnjson Text
key Path
path (Ap (FieldOptDef Text
k Text
_ s -> Maybe a
_ UnjsonDef a
d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Path -> UnjsonDef a -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a
d
findNestedFieldUnjson Text
key Path
path (Ap (FieldDefDef Text
k Text
_ a1
_ s -> a1
_ UnjsonDef a1
d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Path -> UnjsonDef a1 -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a1
d
findNestedFieldUnjson Text
key Path
path (Ap (FieldRODef  Text
k Text
_ s -> a
_ UnjsonDef a
d) Ap (FieldDef s) (a1 -> a)
_r) | Text
kText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
key = Path -> UnjsonDef a -> m Doc
forall (m :: * -> *) a. MonadFail m => Path -> UnjsonDef a -> m Doc
findNestedUnjson Path
path UnjsonDef a
d
findNestedFieldUnjson Text
key Path
path (Ap FieldDef s a1
_ Ap (FieldDef s) (a1 -> a)
r) =
  Text -> Path -> Ap (FieldDef s) (a1 -> a) -> m Doc
forall (m :: * -> *) s a.
MonadFail m =>
Text -> Path -> Ap (FieldDef s) a -> m Doc
findNestedFieldUnjson Text
key Path
path Ap (FieldDef s) (a1 -> a)
r
findNestedFieldUnjson Text
_ Path
_ Ap (FieldDef s) a
_ = String -> m Doc
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"findNestedFieldUnjson"

-- Add some colors to the mix

ansiReset :: String
ansiReset :: String
ansiReset = String
"\ESC[0m"

ansiBold :: String
ansiBold :: String
ansiBold = String
"\ESC[1m"

ansiDimmed :: String
ansiDimmed :: String
ansiDimmed = String
"\ESC[2m"

parseIPv4 :: ReadP.ReadP Word32
parseIPv4 :: ReadP Word32
parseIPv4 = do
  String
d1 <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDigit
  Char
_ <- Char -> ReadP Char
ReadP.char Char
'.'
  String
d2 <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDigit
  Char
_ <- Char -> ReadP Char
ReadP.char Char
'.'
  String
d3 <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDigit
  Char
_ <- Char -> ReadP Char
ReadP.char Char
'.'
  String
d4 <- (Char -> Bool) -> ReadP String
ReadP.munch1 Char -> Bool
isDigit
  ReadP ()
ReadP.eof
  let r :: [Word32]
r = (String -> Word32) -> [String] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map String -> Word32
forall a. Read a => String -> a
read [String
d1,String
d2,String
d3,String
d4]
  Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Word32 -> Bool) -> [Word32] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>Word32
255) [Word32]
r) ReadP ()
forall a. ReadP a
ReadP.pfail
  Word32 -> ReadP Word32
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word32] -> Word32
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Word32 -> Int -> Word32) -> [Word32] -> [Int] -> [Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftL [Word32]
r [Int
24,Int
16,Int
8,Int
0]))


-- | Parse and serialize dotted decimal notation for IPv4 addresses
-- and uses 'Word32' as representation type. Note that network byte
-- order applies, so 127.0.0.1 is 0x7F000001.
unjsonIPv4AsWord32 :: UnjsonDef Word32
unjsonIPv4AsWord32 :: UnjsonDef Word32
unjsonIPv4AsWord32 = Text
-> (Value -> Result Word32)
-> (Word32 -> Value)
-> UnjsonDef Word32
forall k.
Text -> (Value -> Result k) -> (k -> Value) -> UnjsonDef k
SimpleUnjsonDef Text
"IPv4 in decimal dot notation A.B.C.D"
              (\Value
value ->
                case Value -> Result Word32
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
value of
                  Aeson.Success Word32
result ->
                    -- a number, treat it as is, for example 0x7f000001 = 2130706433 = 127.0.0.1
                    Word32 -> Problems -> Result Word32
forall a. a -> Problems -> Result a
Result Word32
result []
                  Aeson.Error String
_ ->
                    case Value -> Result String
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
value of
                      Aeson.Success String
result -> case ReadP Word32 -> ReadS Word32
forall a. ReadP a -> ReadS a
ReadP.readP_to_S ReadP Word32
parseIPv4 String
result of
                        [(Word32
r,String
"")] -> Word32 -> Problems -> Result Word32
forall a. a -> Problems -> Result a
Result Word32
r []
                        [(Word32, String)]
_ -> String -> Result Word32
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot parse as decimal dot IPv4"
                      Aeson.Error String
_ ->
                        String -> Result Word32
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected IPv4 as decimal dot string or a single integer")
              (String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (String -> Value) -> (Word32 -> String) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
showAsIPv4)
  where
    showAsIPv4 :: Word32 -> String
    showAsIPv4 :: Word32 -> String
showAsIPv4 Word32
v = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [Word32 -> String
forall a. Show a => a -> String
show (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR Word32
v Int
b Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
255) | Int
b <- [Int
24,Int
16,Int
8,Int
0]]