{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ToySolver.SAT.Internal.JSON where

import Control.Applicative
import Control.Arrow ((***))
import Control.Monad
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as J
import Data.Aeson ((.=), (.:))
import Data.String
import qualified Data.Text as T

import qualified Data.PseudoBoolean as PBFile
import ToySolver.Internal.JSON
import qualified ToySolver.SAT.Types as SAT

jVar :: SAT.Var -> J.Value
jVar :: Var -> Value
jVar Var
v = [Pair] -> Value
J.object
  [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"variable" :: J.Value)
  , Key
"name" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Var -> Value
forall a. IsString a => Var -> a
jVarName Var
v :: J.Value)
  ]

jVarName :: IsString a => SAT.Var -> a
jVarName :: forall a. IsString a => Var -> a
jVarName Var
v = [Char] -> a
forall a. IsString a => [Char] -> a
fromString ([Char]
"x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show Var
v)

jLitName :: IsString a => SAT.Var -> a
jLitName :: forall a. IsString a => Var -> a
jLitName Var
v
  | Var
v Var -> Var -> Bool
forall a. Ord a => a -> a -> Bool
>= Var
0 = Var -> a
forall a. IsString a => Var -> a
jVarName Var
v
  | Bool
otherwise = [Char] -> a
forall a. IsString a => [Char] -> a
fromString ([Char]
"~x" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show (- Var
v))

parseVar :: J.Value -> J.Parser SAT.Var
parseVar :: Value -> Parser Var
parseVar = [Char] -> (Object -> Parser Var) -> Value -> Parser Var
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withTypedObject [Char]
"variable" ((Object -> Parser Var) -> Value -> Parser Var)
-> (Object -> Parser Var) -> Value -> Parser Var
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Value -> Parser Var
parseVarName (Value -> Parser Var) -> Parser Value -> Parser Var
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

parseVarName :: J.Value -> J.Parser SAT.Var
parseVarName :: Value -> Parser Var
parseVarName = [Char] -> (Text -> Parser Var) -> Value -> Parser Var
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
J.withText [Char]
"variable name" Text -> Parser Var
parseVarNameText

parseVarNameText :: T.Text -> J.Parser SAT.Var
parseVarNameText :: Text -> Parser Var
parseVarNameText Text
name =
  case Text -> Maybe (Char, Text)
T.uncons Text
name of
    Just (Char
'x', Text
rest) | (Var
x,[]) : [(Var, [Char])]
_ <- ReadS Var
forall a. Read a => ReadS a
reads (Text -> [Char]
T.unpack Text
rest) -> Var -> Parser Var
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Var
x
    Maybe (Char, Text)
_ -> [Char] -> Parser Var
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"failed to parse variable name: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name)

jNot :: J.Value -> J.Value
jNot :: Value -> Value
jNot Value
x = [Pair] -> Value
J.object
  [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"operator" :: J.Value)
  , Key
"name" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"not" :: J.Value)
  , Key
"operands" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value
x]
  ]

jLit :: SAT.Lit -> J.Value
jLit :: Var -> Value
jLit Var
l
  | Var
l Var -> Var -> Bool
forall a. Ord a => a -> a -> Bool
> Var
0 = Var -> Value
jVar Var
l
  | Bool
otherwise = Value -> Value
jNot (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Var -> Value
jVar (- Var
l)

parseLit :: J.Value -> J.Parser SAT.Lit
parseLit :: Value -> Parser Var
parseLit Value
x = Value -> Parser Var
parseVar Value
x Parser Var -> Parser Var -> Parser Var
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Value -> Parser Var) -> Value -> Parser Var
forall a. (Value -> Parser a) -> Value -> Parser a
withNot ((Var -> Var) -> Parser Var -> Parser Var
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> Var
forall a. Num a => a -> a
negate (Parser Var -> Parser Var)
-> (Value -> Parser Var) -> Value -> Parser Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Var
parseVar) Value
x

parseLitName :: J.Value -> J.Parser SAT.Lit
parseLitName :: Value -> Parser Var
parseLitName = [Char] -> (Text -> Parser Var) -> Value -> Parser Var
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
J.withText [Char]
"literal" Text -> Parser Var
parseLitNameText

parseLitNameText :: T.Text -> J.Parser SAT.Lit
parseLitNameText :: Text -> Parser Var
parseLitNameText Text
name =
  case Text -> Maybe (Char, Text)
T.uncons Text
name of
    Just (Char
'~', Text
rest) -> Var -> Var
forall a. Num a => a -> a
negate (Var -> Var) -> Parser Var -> Parser Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Var
parseVarNameText Text
rest
    Maybe (Char, Text)
_ -> Text -> Parser Var
parseVarNameText Text
name

jConst :: J.ToJSON a => a -> J.Value
jConst :: forall a. ToJSON a => a -> Value
jConst a
x = [Pair] -> Value
J.object [Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"constant" :: J.Value), Key
"value" Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
x]

parseConst :: J.FromJSON a => J.Value -> J.Parser a
parseConst :: forall a. FromJSON a => Value -> Parser a
parseConst = [Char] -> (Object -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withTypedObject [Char]
"constant" ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Object
obj Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"

jPBSum :: SAT.PBSum -> J.Value
jPBSum :: PBSum -> Value
jPBSum PBSum
s = [Pair] -> Value
J.object
  [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"operator" :: J.Value)
  , Key
"name" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"+" :: J.Value)
  , Key
"operands" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
      [ [Pair] -> Value
J.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"operator" :: J.Value)
          , Key
"name" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"*" :: J.Value)
          , Key
"operands" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Integer -> Value
forall a. ToJSON a => a -> Value
jConst Integer
c Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Var -> Value
jLit Var
lit | Var
lit <- [Var]
lits])
          ]
      | (Integer
c, [Var]
lits) <- PBSum
s
      ]
  ]

parsePBSum :: J.Value -> J.Parser SAT.PBSum
parsePBSum :: Value -> Parser PBSum
parsePBSum Value
x = [Parser PBSum] -> Parser PBSum
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ [Char] -> ([Value] -> Parser PBSum) -> Value -> Parser PBSum
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"+" (([PBSum] -> PBSum) -> Parser [PBSum] -> Parser PBSum
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PBSum] -> PBSum
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Parser [PBSum] -> Parser PBSum)
-> ([Value] -> Parser [PBSum]) -> [Value] -> Parser PBSum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser PBSum) -> [Value] -> Parser [PBSum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser PBSum
parsePBSum) Value
x
  , Value -> Parser (Integer, [Var])
f Value
x Parser (Integer, [Var])
-> ((Integer, [Var]) -> Parser PBSum) -> Parser PBSum
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer, [Var])
term -> PBSum -> Parser PBSum
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Integer, [Var])
term]
  ]
  where
    f :: J.Value -> J.Parser (Integer, [SAT.Lit])
    f :: Value -> Parser (Integer, [Var])
f Value
y = [Parser (Integer, [Var])] -> Parser (Integer, [Var])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
      [ Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseConst Value
y Parser Integer
-> (Integer -> Parser (Integer, [Var])) -> Parser (Integer, [Var])
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
c -> (Integer, [Var]) -> Parser (Integer, [Var])
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
c, [])
      , Value -> Parser Var
parseLit Value
y Parser Var
-> (Var -> Parser (Integer, [Var])) -> Parser (Integer, [Var])
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var
lit -> (Integer, [Var]) -> Parser (Integer, [Var])
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
1, [Var
lit])
      , [Char]
-> ([Value] -> Parser (Integer, [Var]))
-> Value
-> Parser (Integer, [Var])
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"*" ((PBSum -> (Integer, [Var]))
-> Parser PBSum -> Parser (Integer, [Var])
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer)
-> ([[Var]] -> [Var]) -> ([Integer], [[Var]]) -> (Integer, [Var])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[Var]] -> [Var]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (([Integer], [[Var]]) -> (Integer, [Var]))
-> (PBSum -> ([Integer], [[Var]])) -> PBSum -> (Integer, [Var])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBSum -> ([Integer], [[Var]])
forall a b. [(a, b)] -> ([a], [b])
unzip) (Parser PBSum -> Parser (Integer, [Var]))
-> ([Value] -> Parser PBSum) -> [Value] -> Parser (Integer, [Var])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser (Integer, [Var])) -> [Value] -> Parser PBSum
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser (Integer, [Var])
f) Value
y
      ]

jPBConstraint :: PBFile.Constraint -> J.Value
jPBConstraint :: Constraint -> Value
jPBConstraint (PBSum
lhs, Op
op, Integer
rhs) =
  [Pair] -> Value
J.object
  [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Value
"operator" :: J.Value)
  , Key
"name" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (case Op
op of{ Op
PBFile.Ge -> Value
">="; Op
PBFile.Eq -> Value
"=" } :: J.Value)
  , Key
"operands" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [PBSum -> Value
jPBSum PBSum
lhs, Integer -> Value
forall a. ToJSON a => a -> Value
jConst Integer
rhs]
  ]

parsePBConstraint :: J.Value -> J.Parser PBFile.Constraint
parsePBConstraint :: Value -> Parser Constraint
parsePBConstraint Value
x = [Parser Constraint] -> Parser Constraint
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
  [ [Char]
-> ([Value] -> Parser Constraint) -> Value -> Parser Constraint
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
">=" (Op -> [Char] -> [Value] -> Parser Constraint
f Op
PBFile.Ge [Char]
">=") Value
x
  , [Char]
-> ([Value] -> Parser Constraint) -> Value -> Parser Constraint
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"=" (Op -> [Char] -> [Value] -> Parser Constraint
f Op
PBFile.Eq [Char]
"=") Value
x
  ]
  where
    f :: PBFile.Op -> String -> [J.Value] -> J.Parser PBFile.Constraint
    f :: Op -> [Char] -> [Value] -> Parser Constraint
f Op
op [Char]
_opStr [Value
lhs, Value
rhs] = do
      PBSum
lhs' <- Value -> Parser PBSum
parsePBSum Value
lhs
      Integer
rhs' <- Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseConst Value
rhs
      Constraint -> Parser Constraint
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PBSum
lhs', Op
op, Integer
rhs')
    f Op
_ [Char]
opStr [Value]
operands = [Char] -> Parser Constraint
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"wrong number of arguments for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
opStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show ([Value] -> Var
forall a. [a] -> Var
forall (t :: * -> *) a. Foldable t => t a -> Var
length [Value]
operands) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected 1)")


withOperator :: String -> ([J.Value] -> J.Parser a) -> J.Value -> J.Parser a
withOperator :: forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
name [Value] -> Parser a
k = [Char] -> (Object -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withTypedObject [Char]
"operator" ((Object -> Parser a) -> Value -> Parser a)
-> (Object -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  [Char]
op <- Object
obj Object -> Key -> Parser [Char]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
op) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ()
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"expected operator name " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", but found type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
op)
  [Value]
operands <- Object
obj Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operands"
  [Value] -> Parser a
k [Value]
operands

withNot :: (J.Value -> J.Parser a) -> J.Value -> J.Parser a
withNot :: forall a. (Value -> Parser a) -> Value -> Parser a
withNot Value -> Parser a
k = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"not" (([Value] -> Parser a) -> Value -> Parser a)
-> ([Value] -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \[Value]
operands -> do
  case [Value]
operands of
    [Value
x] -> Value -> Parser a
k Value
x
    [Value]
_ -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"wrong number of arguments for \"not\" (given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show ([Value] -> Var
forall a. [a] -> Var
forall (t :: * -> *) a. Foldable t => t a -> Var
length [Value]
operands) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected 1)")

withAnd :: ([J.Value] -> J.Parser a) -> J.Value -> J.Parser a
withAnd :: forall a. ([Value] -> Parser a) -> Value -> Parser a
withAnd = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"and"

withOr :: ([J.Value] -> J.Parser a) -> J.Value -> J.Parser a
withOr :: forall a. ([Value] -> Parser a) -> Value -> Parser a
withOr = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"or"

withITE :: (J.Value -> J.Value -> J.Value -> J.Parser a) -> J.Value -> J.Parser a
withITE :: forall a.
(Value -> Value -> Value -> Parser a) -> Value -> Parser a
withITE Value -> Value -> Value -> Parser a
k = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"ite" (([Value] -> Parser a) -> Value -> Parser a)
-> ([Value] -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \[Value]
operands -> do
  case [Value]
operands of
    [Value
c, Value
t, Value
e] -> Value -> Value -> Value -> Parser a
k Value
c Value
t Value
e
    [Value]
_ -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"wrong number of arguments for \"ite\" (given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show ([Value] -> Var
forall a. [a] -> Var
forall (t :: * -> *) a. Foldable t => t a -> Var
length [Value]
operands) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected 3)")

withImply :: (J.Value -> J.Value -> J.Parser a) -> J.Value -> J.Parser a
withImply :: forall a. (Value -> Value -> Parser a) -> Value -> Parser a
withImply Value -> Value -> Parser a
k = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"=>" (([Value] -> Parser a) -> Value -> Parser a)
-> ([Value] -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \[Value]
operands -> do
  case [Value]
operands of
    [Value
a, Value
b] -> Value -> Value -> Parser a
k Value
a Value
b
    [Value]
_ -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"wrong number of arguments for \"=>\" (given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show ([Value] -> Var
forall a. [a] -> Var
forall (t :: * -> *) a. Foldable t => t a -> Var
length [Value]
operands) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected 2)")

withEquiv :: (J.Value -> J.Value -> J.Parser a) -> J.Value -> J.Parser a
withEquiv :: forall a. (Value -> Value -> Parser a) -> Value -> Parser a
withEquiv Value -> Value -> Parser a
k = [Char] -> ([Value] -> Parser a) -> Value -> Parser a
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withOperator [Char]
"<=>" (([Value] -> Parser a) -> Value -> Parser a)
-> ([Value] -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \[Value]
operands -> do
  case [Value]
operands of
    [Value
a, Value
b] -> Value -> Value -> Parser a
k Value
a Value
b
    [Value]
_ -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"wrong number of arguments for \"<=>\" (given " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Show a => a -> [Char]
show ([Value] -> Var
forall a. [a] -> Var
forall (t :: * -> *) a. Foldable t => t a -> Var
length [Value]
operands) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected 2)")