-- |
-- Module      : Conjure.Conjurable
-- Copyright   : (c) 2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of "Conjure".
--
-- This defines the 'Conjurable' typeclass
-- and utilities involving it.
--
-- You are probably better off importing "Conjure".
module Conjure.Conjurable
  ( Reification1
  , Reification
  , Conjurable (..)
  , conjureType
  , reifyTiers
  , reifyEquality
  , reifyExpress
  , conjureApplication
  , conjureVarApplication
  , conjurePats
  , conjureHoles
  , conjureTiersFor
  , conjureAreEqual
  , conjureMkEquation
  , A, B, C, D, E, F
  , conjureIsDeconstructor
  , conjureIsDeconstruction
  , candidateDeconstructionsFrom
  , conjureIsUnbreakable
  , conjureReification
  , conjureReification1
  , conjureDynamicEq
  , cevaluate
  , ceval
  , cevl
  , Name (..)
  , Express (..)
  )
where

import Test.LeanCheck
import Test.LeanCheck.Utils
import Test.LeanCheck.Error (errorToFalse)
import Conjure.Expr hiding (application)
import Conjure.Defn
import Test.Speculate.Expr
import Data.Functor ((<$>))
import Control.Applicative ((<*>))
import Data.Dynamic
import Data.Express

import Data.Int     -- for instances
import Data.Word    -- for instances
import Data.Ratio   -- for instance
import Data.Complex -- for instance


-- | Single reification of some functions over a type as 'Expr's.
--
-- This is a sixtuple, in order:
--
-- 1. a hole encoded as an 'Expr';
-- 2. the '==' function encoded as an 'Expr' when available;
-- 3. 'tiers' of enumerated test values encoded as 'Expr's when available;
-- 4. infinite list of potential variable names;
-- 5. boolean indicating whether the type is atomic;
-- 6. the 'conjureSize' function encoded as an 'Expr'.
type Reification1  =  (Expr, Maybe Expr, Maybe [[Expr]], [String], Bool, Expr)

-- | A reification over a collection of types.
--
-- Represented as a transformation of a list to a list.
type Reification  =  [Reification1] -> [Reification1]


-- | A primtive expression (paired with instance reification).
type Prim  =  (Expr, Reification)


-- | Provides a primitive value to Conjure.
--   To be used on 'Show' instances.
--   (cf. 'prim')
pr :: (Conjurable a, Show a) => a -> Prim
pr :: a -> Prim
pr a
x  =  (a -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val a
x, a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x)


-- | Provides a primitive value to Conjure.
--   To be used on values that are not 'Show' instances
--   such as functions.
--   (cf. 'pr')
prim :: Conjurable a => String -> a -> Prim
prim :: String -> a -> Prim
prim String
s a
x  =  (String -> a -> Expr
forall a. Typeable a => String -> a -> Expr
value String
s a
x, a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x)


-- | Class of 'Conjurable' types.
-- Functions are 'Conjurable'
-- if all their arguments are 'Conjurable', 'Listable' and 'Show'able.
--
-- For atomic types that are 'Listable',
-- instances are defined as:
--
-- > instance Conjurable Atomic where
-- >   conjureTiers  =  reifyTiers
--
-- For atomic types that are both 'Listable' and 'Eq',
-- instances are defined as:
--
-- > instance Conjurable Atomic where
-- >   conjureTiers     =  reifyTiers
-- >   conjureEquality  =  reifyEquality
--
-- For types with subtypes,
-- instances are defined as:
--
-- > instance Conjurable Composite where
-- >   conjureTiers     =  reifyTiers
-- >   conjureEquality  =  reifyEquality
-- >   conjureSubTypes x  =  conjureType y
-- >                      .  conjureType z
-- >                      .  conjureType w
-- >     where
-- >     (Composite ... y ... z ... w ...)  =  x
--
-- Above @x@, @y@, @z@ and @w@ are just proxies.
-- The @Proxy@ type was avoided for backwards compatibility.
--
-- Please see the source code of "Conjure.Conjurable" for more examples.
--
-- (cf. 'reifyTiers', 'reifyEquality', 'conjureType')
class (Typeable a, Name a) => Conjurable a where
  conjureArgumentHoles :: a -> [Expr]
  conjureArgumentHoles a
_  =  []

  -- | Returns 'Just' the '==' function encoded as an 'Expr' when available
  --   or 'Nothing' otherwise.
  --
  -- Use 'reifyEquality' when defining this.
  conjureEquality :: a -> Maybe Expr
  conjureEquality a
_  =  Maybe Expr
forall a. Maybe a
Nothing

  -- | Returns 'Just' 'tiers' of values encoded as 'Expr's when possible
  --   or 'Nothing' otherwise.
  --
  -- Use 'reifyTiers' when defining this.
  conjureTiers :: a -> Maybe [[Expr]]
  conjureTiers a
_  =  Maybe [[Expr]]
forall a. Maybe a
Nothing

  conjureSubTypes :: a -> Reification
  conjureSubTypes a
_  =  Reification
forall a. a -> a
id

  -- | Returns an if-function encoded as an 'Expr'.
  conjureIf :: a -> Expr
  conjureIf   =  a -> Expr
forall a. Typeable a => a -> Expr
ifFor

  -- | Returns a top-level case breakdown.
  conjureCases :: a -> [Expr]
  conjureCases a
_  =  []

  conjureArgumentCases :: a -> [[Expr]]
  conjureArgumentCases a
_  =  []

  -- | Returns the (recursive) size of the given value.
  conjureSize :: a -> Int
  conjureSize a
_  =  Int
0

  -- | Returns a function that deeply reencodes an expression when possible.
  --   ('id' when not available.)
  --
  -- Use 'reifyExpress' when defining this.
  conjureExpress :: a -> Expr -> Expr

  conjureEvaluate :: (Expr->Expr) -> Int -> Defn -> Expr -> Maybe a
  conjureEvaluate  =  (Expr -> Expr) -> Int -> Defn -> Expr -> Maybe a
forall a.
Typeable a =>
(Expr -> Expr) -> Int -> Defn -> Expr -> Maybe a
devaluate


-- | To be used in the implementation of 'conjureSubTypes'.
--
-- > instance ... => Conjurable <Type> where
-- >   ...
-- >   conjureSubTypes x  =  conjureType (field1 x)
-- >                      .  conjureType (field2 x)
-- >                      .  ...
-- >                      .  conjureType (fieldN x)
-- >   ...
conjureType :: Conjurable a => a -> Reification
conjureType :: a -> Reification
conjureType a
x [Reification1]
ms  =
  if a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> [Expr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Expr
h | (Expr
h,Maybe Expr
_,Maybe [[Expr]]
_,[String]
_,Bool
_,Expr
_) <- [Reification1]
ms]
  then [Reification1]
ms
  else a -> Reification
forall a. Conjurable a => a -> Reification
conjureSubTypes a
x Reification -> Reification
forall a b. (a -> b) -> a -> b
$ a -> Reification1
forall a. Conjurable a => a -> Reification1
conjureReification1 a
x Reification1 -> Reification
forall a. a -> [a] -> [a]
: [Reification1]
ms

-- | like 'conjureType' but without type repetitions
nubConjureType :: Conjurable a => a -> Reification
nubConjureType :: a -> Reification
nubConjureType a
x  =  (Reification1 -> Expr) -> Reification
forall b a. Eq b => (a -> b) -> [a] -> [a]
nubOn (\(Expr
eh,Maybe Expr
_,Maybe [[Expr]]
_,[String]
_,Bool
_,Expr
_) -> Expr
eh) Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
-- The use of nubOn above is O(n^2).
-- So long as there is not a huge number of subtypes of a, so we're fine.

-- | Conjures a 'Reification1' for a 'Conjurable' type.
--
-- This is used in the implementation of 'conjureReification'.
conjureReification1 :: Conjurable a => a -> Reification1
conjureReification1 :: a -> Reification1
conjureReification1 a
x  =  (a -> Expr
forall a. Typeable a => a -> Expr
hole a
x, a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x, a -> Maybe [[Expr]]
forall a. Conjurable a => a -> Maybe [[Expr]]
conjureTiers a
x, a -> [String]
forall a. Name a => a -> [String]
names a
x, [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Expr] -> Bool) -> [Expr] -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureCases a
x, String -> (a -> Int) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"conjureSize" (a -> Int
forall a. Conjurable a => a -> Int
conjureSize (a -> Int) -> a -> a -> Int
forall a b. (a -> b) -> a -> a -> b
-:> a
x))

-- | Conjures a list of 'Reification1'
--   for a 'Conjurable' type, its subtypes and 'Bool'.
--
-- This is used in the implementation of
-- 'conjureHoles',
-- 'conjureMkEquation',
-- 'conjureAreEqual',
-- 'conjureTiersFor',
-- 'conjureIsDeconstructor',
-- 'conjureNamesFor',
-- 'conjureIsUnbreakable',
-- etc.
conjureReification :: Conjurable a => a -> [Reification1]
conjureReification :: a -> [Reification1]
conjureReification a
x  =  a -> Reification
forall a. Conjurable a => a -> Reification
nubConjureType a
x [Bool -> Reification1
forall a. Conjurable a => a -> Reification1
conjureReification1 Bool
bool]
  where
  bool :: Bool
  bool :: Bool
bool  =  String -> Bool
forall a. HasCallStack => String -> a
error String
"conjureReification: evaluated proxy boolean value (definitely a bug)"

-- | Reifies equality '==' in a 'Conjurable' type instance.
--
-- This is to be used
-- in the definition of 'conjureEquality'
-- of 'Conjurable' typeclass instances:
--
-- > instance ... => Conjurable <Type> where
-- >   ...
-- >   conjureEquality  =  reifyEquality
-- >   ...
reifyEquality :: (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality :: a -> Maybe Expr
reifyEquality  =  Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> (a -> Expr) -> a -> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr
forall a. [a] -> a
head ([Expr] -> Expr) -> (a -> [Expr]) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Expr]
forall a. (Typeable a, Eq a) => a -> [Expr]
reifyEq

-- | Reifies equality to be used in a conjurable type.
--
-- This is to be used
-- in the definition of 'conjureTiers'
-- of 'Conjurable' typeclass instances:
--
-- > instance ... => Conjurable <Type> where
-- >   ...
-- >   conjureTiers  =  reifyTiers
-- >   ...
reifyTiers :: (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers :: a -> Maybe [[Expr]]
reifyTiers  =  [[Expr]] -> Maybe [[Expr]]
forall a. a -> Maybe a
Just ([[Expr]] -> Maybe [[Expr]])
-> (a -> [[Expr]]) -> a -> Maybe [[Expr]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> [[Expr]]
mkExprTiers

-- | Reifies the 'expr' function in a 'Conjurable' type instance.
--
-- This is to be used
-- in the definition of 'conjureExpress'
-- of 'Conjurable' typeclass instances.
--
-- > instance ... => Conjurable <Type> where
-- >   ...
-- >   conjureExpress  =  reifyExpress
-- >   ...
reifyExpress :: (Express a, Show a) => a -> Expr -> Expr
reifyExpress :: a -> Expr -> Expr
reifyExpress a
a Expr
e  =  case String -> (a -> Expr) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"expr" (a -> Expr
forall a. Express a => a -> Expr
expr (a -> Expr) -> a -> a -> Expr
forall a b. (a -> b) -> a -> a -> b
-:> a
a) Expr -> Expr -> Maybe Expr
$$ Expr
e of
  Maybe Expr
Nothing -> Expr
e         -- TODO: consider throwing an error
  Just Expr
e' -> Expr -> Expr -> Expr
forall a. Typeable a => a -> Expr -> a
eval Expr
e Expr
e' -- TODO: consider throwing an error

mkExprTiers :: (Listable a, Show a, Typeable a) => a -> [[Expr]]
mkExprTiers :: a -> [[Expr]]
mkExprTiers a
a  =  (a -> Expr) -> [[a]] -> [[Expr]]
forall a b. (a -> b) -> [[a]] -> [[b]]
mapT a -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val ([[a]]
forall a. Listable a => [[a]]
tiers [[a]] -> [[a]] -> [[a]]
forall a. a -> a -> a
-: [[a
a]])

-- | Computes a list of holes encoded as 'Expr's
--   from a 'Conjurable' functional value.
--
-- (cf. 'Conjure.Prim.cjHoles')
conjureHoles :: Conjurable f => f -> [Expr]
conjureHoles :: f -> [Expr]
conjureHoles f
f  =  [Expr
eh | (Expr
eh,Maybe Expr
_,Just [[Expr]]
_,[String]
_,Bool
_,Expr
_) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f]

-- | Computes a function that makes an equation between two expressions.
conjureMkEquation :: Conjurable f => f -> Expr -> Expr -> Expr
conjureMkEquation :: f -> Expr -> Expr -> Expr
conjureMkEquation f
f  =  [Expr] -> Expr -> Expr -> Expr
mkEquation [Expr
eq | (Expr
_,Just Expr
eq,Maybe [[Expr]]
_,[String]
_,Bool
_,Expr
_) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f]

conjureDynamicEq :: Conjurable f => f -> Dynamic
conjureDynamicEq :: f -> Dynamic
conjureDynamicEq f
f  =  case f -> Expr -> Expr -> Expr
forall f. Conjurable f => f -> Expr -> Expr -> Expr
conjureMkEquation f
f Expr
efxs Expr
efxs of
                       (Value String
"==" Dynamic
deq :$ Expr
_ :$ Expr
_) -> Dynamic
deq
                       Expr
_ -> String -> Dynamic
forall a. HasCallStack => String -> a
error String
"conjureDynamicEq: expected an == but found something else.  Bug!"
  where
  efxs :: Expr
efxs  =  String -> f -> Expr
forall f. Conjurable f => String -> f -> Expr
conjureApplication String
"f" f
f

-- | Given a 'Conjurable' functional value,
--   computes a function that checks whether two 'Expr's are equal
--   up to a given number of tests.
conjureAreEqual :: Conjurable f => f -> Int -> Expr -> Expr -> Bool
conjureAreEqual :: f -> Int -> Expr -> Expr -> Bool
conjureAreEqual f
f Int
maxTests  =  Expr -> Expr -> Bool
(===)
  where
  -==- :: Expr -> Expr -> Expr
(-==-)  =  f -> Expr -> Expr -> Expr
forall f. Conjurable f => f -> Expr -> Expr -> Expr
conjureMkEquation f
f
  Expr
e1 === :: Expr -> Expr -> Bool
=== Expr
e2  =  Expr -> Bool
isTrue (Expr -> Bool) -> Expr -> Bool
forall a b. (a -> b) -> a -> b
$ Expr
e1 Expr -> Expr -> Expr
-==- Expr
e2
  isTrue :: Expr -> Bool
isTrue  =  (Expr -> Bool) -> [Expr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
errorToFalse (Bool -> Bool) -> (Expr -> Bool) -> Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Bool
forall a. Typeable a => a -> Expr -> a
eval Bool
False) ([Expr] -> Bool) -> (Expr -> [Expr]) -> Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
gs
  gs :: Expr -> [Expr]
gs  =  Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
maxTests ([Expr] -> [Expr]) -> (Expr -> [Expr]) -> Expr -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (f -> Expr -> [[Expr]]
forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f)

-- | Compute 'tiers' of values encoded as 'Expr's
--   of the type of the given 'Expr'.
conjureTiersFor :: Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor :: f -> Expr -> [[Expr]]
conjureTiersFor f
f Expr
e  =  [[[Expr]]] -> [[Expr]]
tf [[[Expr]]]
allTiers
  where
  allTiers :: [ [[Expr]] ]
  allTiers :: [[[Expr]]]
allTiers  =  [[[Expr]]
etiers | (Expr
_,Maybe Expr
_,Just [[Expr]]
etiers,[String]
_,Bool
_,Expr
_) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f]
  tf :: [[[Expr]]] -> [[Expr]]
tf []  =  [[Expr
e]] -- no tiers found, keep variable
  tf ([[Expr]]
etiers:[[[Expr]]]
etc)  =  case [[Expr]]
etiers of
                      ((Expr
e':[Expr]
_):[[Expr]]
_) | Expr -> TypeRep
typ Expr
e' TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
e -> [[Expr]]
etiers
                      [[Expr]]
_                            -> [[[Expr]]] -> [[Expr]]
tf [[[Expr]]]
etc

-- | Compute variable names for the given 'Expr' type.
conjureNamesFor :: Conjurable f => f -> Expr -> [String]
conjureNamesFor :: f -> Expr -> [String]
conjureNamesFor f
f Expr
e  =  [[String]] -> [String]
forall a. [a] -> a
head
                     ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$  [[String]
ns | (Expr
eh, Maybe Expr
_, Maybe [[Expr]]
_, [String]
ns, Bool
_, Expr
_) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f, Expr -> TypeRep
typ Expr
e TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
eh]
                     [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++ [Int -> [String]
forall a. Name a => a -> [String]
names (Int
forall a. HasCallStack => a
undefined :: Int)] -- use [Int] on lists

conjureMostGeneralCanonicalVariation :: Conjurable f => f -> Expr -> Expr
conjureMostGeneralCanonicalVariation :: f -> Expr -> Expr
conjureMostGeneralCanonicalVariation f
f  =  (Expr -> [String]) -> Expr -> Expr
canonicalizeWith (f -> Expr -> [String]
forall f. Conjurable f => f -> Expr -> [String]
conjureNamesFor f
f)
                                        (Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Expr -> Expr
fastMostGeneralVariation

-- | Checks if an unary function encoded as an 'Expr' is a deconstructor.
--
-- (cf. 'conjureIsDeconstruction')
conjureIsDeconstructor :: Conjurable f => f -> Int -> Expr -> Bool
conjureIsDeconstructor :: f -> Int -> Expr -> Bool
conjureIsDeconstructor f
f Int
maxTests Expr
e  =  case [Expr]
as of
  [] -> Bool
False
  (Expr
h:[Expr]
_) -> Expr -> Bool
isDec Expr
h
  where
  as :: [Expr]
as  =  [Expr
h | Expr
h <- [Expr]
hs, Expr -> Bool
isWellTyped (Expr
eExpr -> Expr -> Expr
:$Expr
h), Expr -> TypeRep
typ (Expr
eExpr -> Expr -> Expr
:$Expr
h) TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
h]
  hs :: [Expr]
hs  =  f -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f
  isDec :: Expr -> Bool
isDec Expr
h  =  (Expr -> Bool) -> [Expr] -> Int
forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
is [Expr]
gs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    where
    gs :: [Expr]
gs  =  Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
maxTests ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (f -> Expr -> [[Expr]]
forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f) Expr
h
    sz :: Expr
sz  =  [Expr] -> Expr
forall a. [a] -> a
head [Expr
sz | (Expr
_, Maybe Expr
_, Maybe [[Expr]]
_, [String]
_, Bool
_, Expr
sz) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f
                    , Expr -> Bool
isWellTyped (Expr
sz Expr -> Expr -> Expr
:$ Expr
h)]
    esz :: Expr -> Int
esz Expr
e  =  Int -> Expr -> Int
forall a. Typeable a => a -> Expr -> a
eval (Int
0::Int) (Expr
sz Expr -> Expr -> Expr
:$ Expr
e)
    is :: Expr -> Bool
is Expr
e'  =  Bool -> Bool
errorToFalse (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz (Expr
e Expr -> Expr -> Expr
:$ Expr
e') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Expr -> Int
esz Expr
e'

-- | Checks if an expression is a deconstruction.
--
-- There should be a single 'hole' in the expression.
--
-- 1. The result does not increase the size for at least half the time.
-- 2. The result decreases in size for at least a third of the time.
--
-- (cf. 'conjureIsDeconstructor')
conjureIsDeconstruction :: Conjurable f => f -> Int -> Expr -> Bool
conjureIsDeconstruction :: f -> Int -> Expr -> Bool
conjureIsDeconstruction f
f Int
maxTests Expr
ed  =  [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expr -> [Expr]
holes Expr
ed) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                                       Bool -> Bool -> Bool
&& Expr -> TypeRep
typ Expr
h TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
ed
                                       Bool -> Bool -> Bool
&& (Expr -> Bool) -> [Expr] -> Int
forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
is [Expr]
gs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                                       Bool -> Bool -> Bool
&& (Expr -> Bool) -> [Expr] -> Int
forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
iz [Expr]
gs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
  where
  gs :: [Expr]
gs  =  Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
maxTests ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (f -> Expr -> [[Expr]]
forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f) Expr
ed
  [Expr
h]  =  Expr -> [Expr]
holes Expr
ed
  sz :: Expr
sz  =  [Expr] -> Expr
forall a. [a] -> a
head [Expr
sz | (Expr
_, Maybe Expr
_, Maybe [[Expr]]
_, [String]
_, Bool
_, Expr
sz) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f
                  , Expr -> Bool
isWellTyped (Expr
sz Expr -> Expr -> Expr
:$ Expr
h)]
  esz :: Expr -> Int
esz Expr
e  =  Int -> Expr -> Int
forall a. Typeable a => a -> Expr -> a
eval (Int
0::Int) (Expr
sz Expr -> Expr -> Expr
:$ Expr
e)
  is :: Expr -> Bool
is Expr
e  =  Bool -> Bool
errorToFalse (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz Expr
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Expr -> Int
esz (Expr -> Expr
holeValue Expr
e)
  iz :: Expr -> Bool
iz Expr
e  =  Bool -> Bool
errorToFalse (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz Expr
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Expr -> Int
esz (Expr -> Expr
holeValue Expr
e)
  holeValue :: Expr -> Expr
holeValue Expr
e  =  Expr -> Maybe Expr -> Expr
forall a. a -> Maybe a -> a
fromMaybe Expr
forall a. a
err
               (Maybe Expr -> Expr)
-> (Maybe Defn -> Maybe Expr) -> Maybe Defn -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Expr -> Defn -> Maybe Expr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Expr
h
               (Defn -> Maybe Expr)
-> (Maybe Defn -> Defn) -> Maybe Defn -> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Defn -> Maybe Defn -> Defn
forall a. a -> Maybe a -> a
fromMaybe Defn
forall a. a
err
               (Maybe Defn -> Expr) -> Maybe Defn -> Expr
forall a b. (a -> b) -> a -> b
$  Expr
e Expr -> Expr -> Maybe Defn
`match` Expr
ed
  err :: a
err  =  String -> a
forall a. HasCallStack => String -> a
error String
"conjureIsDeconstructor: the impossible happened"

-- | Compute candidate deconstructions from an 'Expr'.
--
-- This is used in the implementation of
-- 'Conjure.Engine.candidateDefnsC' and 'Conjure.Engine.candidateExprs'
-- followed by 'conjureIsDeconstruction'.
candidateDeconstructionsFrom :: Expr -> [Expr]
candidateDeconstructionsFrom :: Expr -> [Expr]
candidateDeconstructionsFrom Expr
e  =
  [ Expr
e'
  | Expr
v <- Expr -> [Expr]
vars Expr
e
  , Expr -> TypeRep
typ Expr
v TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
e
  , let e' :: Expr
e' = Expr
e Expr -> Defn -> Expr
//- [(Expr
v, Expr -> Expr
holeAsTypeOf Expr
v)]
  , [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expr -> [Expr]
holes Expr
e') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  ]

-- | Checks if an 'Expr' is of an unbreakable type.
conjureIsUnbreakable :: Conjurable f => f -> Expr -> Bool
conjureIsUnbreakable :: f -> Expr -> Bool
conjureIsUnbreakable f
f Expr
e  =  [Bool] -> Bool
forall a. [a] -> a
head
  [Bool
is | (Expr
h,Maybe Expr
_,Maybe [[Expr]]
_,[String]
_,Bool
is,Expr
_) <- f -> [Reification1]
forall a. Conjurable a => a -> [Reification1]
conjureReification f
f, Expr -> TypeRep
typ Expr
h TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
e]

instance Conjurable () where
  conjureExpress :: () -> Expr -> Expr
conjureExpress   =  () -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: () -> Maybe Expr
conjureEquality  =  () -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: () -> Maybe [[Expr]]
conjureTiers     =  () -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureCases :: () -> [Expr]
conjureCases ()
_   =  [() -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val ()]

instance Conjurable Bool where
  conjureExpress :: Bool -> Expr -> Expr
conjureExpress   =  Bool -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Bool -> Maybe Expr
conjureEquality  =  Bool -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Bool -> Maybe [[Expr]]
conjureTiers     =  Bool -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureCases :: Bool -> [Expr]
conjureCases Bool
_   =  [Bool -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val Bool
False, Bool -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val Bool
True]

instance Conjurable Int where
  conjureExpress :: Int -> Expr -> Expr
conjureExpress   =  Int -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Int -> Maybe Expr
conjureEquality  =  Int -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Int -> Maybe [[Expr]]
conjureTiers     =  Int -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Int -> Int
conjureSize      =  Int -> Int
forall a. Num a => a -> a
abs

instance Conjurable Integer where
  conjureExpress :: Integer -> Expr -> Expr
conjureExpress   =  Integer -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Integer -> Maybe Expr
conjureEquality  =  Integer -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Integer -> Maybe [[Expr]]
conjureTiers     =  Integer -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Integer -> Int
conjureSize      =  Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (Integer -> Integer) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
abs

instance Conjurable Char where
  conjureExpress :: Char -> Expr -> Expr
conjureExpress   =  Char -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Char -> Maybe Expr
conjureEquality  =  Char -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Char -> Maybe [[Expr]]
conjureTiers     =  Char -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers

-- bind equality to the given argument type
(==:) :: (a -> a -> Bool) -> a -> (a -> a -> Bool)
==: :: (a -> a -> Bool) -> a -> a -> a -> Bool
(==:)  =  (a -> a -> Bool) -> a -> a -> a -> Bool
forall a b. a -> b -> a
const

-- the reconstruction of equality functions for polymorphic types
-- such as [a], (a,b), Maybe a, Either a b
-- is only needed so we don't impose an Eq restriction on the type context.

instance (Conjurable a, Listable a, Express a, Show a) => Conjurable [a] where
  conjureExpress :: [a] -> Expr -> Expr
conjureExpress   =  [a] -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureSubTypes :: [a] -> Reification
conjureSubTypes [a]
xs  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType ([a] -> a
forall a. [a] -> a
head [a]
xs)
  conjureTiers :: [a] -> Maybe [[Expr]]
conjureTiers     =  [a] -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: [a] -> Int
conjureSize      =  [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  conjureCases :: [a] -> [Expr]
conjureCases [a]
xs  =  [ [a] -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val ([] [a] -> [a] -> [a]
forall a. a -> a -> a
-: [a]
xs)
                      , String -> (a -> [a] -> [a]) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
":" ((:) (a -> [a] -> [a]) -> [a] -> a -> [a] -> [a]
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: [a]
xs) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ [a] -> Expr
forall a. Typeable a => a -> Expr
hole [a]
xs
                      ]  where  x :: a
x  =  [a] -> a
forall a. [a] -> a
head [a]
xs
  conjureEquality :: [a] -> Maybe Expr
conjureEquality [a]
xs  =  Expr -> Expr
from (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
    where
    x :: a
x  =  [a] -> a
forall a. [a] -> a
head [a]
xs
    from :: Expr -> Expr
from Expr
e  =  String -> ([a] -> [a] -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" [a] -> [a] -> Bool
(==)
      where
      .==. :: a -> a -> Bool
(.==.)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      []     == :: [a] -> [a] -> Bool
== []     = Bool
True
      (a
x:[a]
xs) == []     = Bool
False
      []     == (a
y:[a]
ys) = Bool
False
      (a
x:[a]
xs) == (a
y:[a]
ys) = a
x a -> a -> Bool
.==. a
y Bool -> Bool -> Bool
&& [a]
xs [a] -> [a] -> Bool
== [a]
ys

instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         ) => Conjurable (a,b) where
  conjureExpress :: (a, b) -> Expr -> Expr
conjureExpress   =  (a, b) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b) -> Maybe [[Expr]]
conjureTiers     =  (a, b) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b) -> Reification
conjureSubTypes (a, b)
xy  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
xy)
                      Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType ((a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
xy)
  conjureCases :: (a, b) -> [Expr]
conjureCases (a, b)
xy  =  [String -> (a -> b -> (a, b)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"," ((,) (a -> b -> (a, b)) -> (a, b) -> a -> b -> (a, b)
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: (a, b)
xy) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Typeable a => a -> Expr
hole b
y]
    where
    (a
x,b
y) = (a
forall a. HasCallStack => a
undefined,b
forall a. HasCallStack => a
undefined) (a, b) -> (a, b) -> (a, b)
forall a. a -> a -> a
-: (a, b)
xy
  conjureEquality :: (a, b) -> Maybe Expr
conjureEquality (a, b)
xy  =  Expr -> Expr -> Expr
from (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
    where
    (a
x,b
y)  =  (a, b)
xy
    from :: Expr -> Expr -> Expr
from Expr
e1 Expr
e2  =  String -> ((a, b) -> (a, b) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b) -> (a, b) -> Bool
(==)
      where
      ==. :: a -> a -> Bool
(==.)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .== :: b -> b -> Bool
(.==)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      (a
x1,b
y1) == :: (a, b) -> (a, b) -> Bool
== (a
x2,b
y2)  =  a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.== b
y2


instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         , Conjurable c, Listable c, Show c, Express c
         ) => Conjurable (a,b,c) where
  conjureExpress :: (a, b, c) -> Expr -> Expr
conjureExpress   =  (a, b, c) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c) -> Maybe [[Expr]]
conjureTiers     =  (a, b, c) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c) -> Reification
conjureSubTypes (a, b, c)
xyz =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
                      Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
y
                      Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  c -> Reification
forall a. Conjurable a => a -> Reification
conjureType c
z
                      where (a
x,b
y,c
z) = (a, b, c)
xyz
  conjureCases :: (a, b, c) -> [Expr]
conjureCases (a, b, c)
xyz  =  [String -> (a -> b -> c -> (a, b, c)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
",," ((,,) (a -> b -> c -> (a, b, c)) -> (a, b, c) -> a -> b -> c -> (a, b, c)
forall a b c d. (a -> b -> c -> d) -> d -> a -> b -> c -> d
->>>: (a, b, c)
xyz) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Typeable a => a -> Expr
hole b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Typeable a => a -> Expr
hole c
z]
    where
    (a
x,b
y,c
z) = (a
forall a. HasCallStack => a
undefined,b
forall a. HasCallStack => a
undefined,c
forall a. HasCallStack => a
undefined) (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. a -> a -> a
-: (a, b, c)
xyz
  conjureEquality :: (a, b, c) -> Maybe Expr
conjureEquality (a, b, c)
xyz  =  Expr -> Expr -> Expr -> Expr
from
                      (Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                      Maybe (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                      Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
    where
    (a
x,b
y,c
z)  =  (a, b, c)
xyz
    from :: Expr -> Expr -> Expr -> Expr
from Expr
e1 Expr
e2 Expr
e3  =  String -> ((a, b, c) -> (a, b, c) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c) -> (a, b, c) -> Bool
(==)
      where
      ==.. :: a -> a -> Bool
(==..)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==. :: b -> b -> Bool
(.==.)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..== :: c -> c -> Bool
(..==)  =  Expr -> c -> c -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e3 (c -> c -> Bool) -> c -> c -> c -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      (a
x1,b
y1,c
z1) == :: (a, b, c) -> (a, b, c) -> Bool
== (a
x2,b
y2,c
z2)  =  a
x1 a -> a -> Bool
==.. a
x2
                                Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==. b
y2
                                Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..== c
z2

instance (Conjurable a, Listable a, Show a, Express a) => Conjurable (Maybe a) where
  conjureExpress :: Maybe a -> Expr -> Expr
conjureExpress   =  Maybe a -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: Maybe a -> Maybe [[Expr]]
conjureTiers     =  Maybe a -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: Maybe a -> Reification
conjureSubTypes Maybe a
mx  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mx)
  conjureCases :: Maybe a -> [Expr]
conjureCases Maybe a
mx  =  [ String -> Maybe a -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Nothing" (Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a -> Maybe a
forall a. a -> a -> a
-: Maybe a
mx)
                      , String -> (a -> Maybe a) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Just" (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> a -> Maybe a
forall a b. (a -> b) -> b -> a -> b
->: Maybe a
mx) Expr -> Expr -> Expr
:$ Maybe a -> Expr
forall a. Typeable a => a -> Expr
hole Maybe a
x
                      ]
    where
    x :: Maybe a
x  =  a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. HasCallStack => a
undefined Maybe a -> Maybe a -> Maybe a
forall a. a -> a -> a
-: Maybe a
mx
  conjureEquality :: Maybe a -> Maybe Expr
conjureEquality Maybe a
mx  =  Expr -> Expr
from (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
    where
    x :: a
x  =  Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mx
    from :: Expr -> Expr
from Expr
e  =  String -> (Maybe a -> Maybe a -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" Maybe a -> Maybe a -> Bool
(==)
      where
      .==. :: a -> a -> Bool
(.==.)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      Maybe a
Nothing  == :: Maybe a -> Maybe a -> Bool
== Maybe a
Nothing   =  Bool
True
      Maybe a
Nothing  == (Just a
_)  =  Bool
False
      (Just a
_) == Maybe a
Nothing   =  Bool
False
      (Just a
x) == (Just a
y)  =  a
x a -> a -> Bool
.==. a
y


instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         ) => Conjurable (Either a b) where
  conjureExpress :: Either a b -> Expr -> Expr
conjureExpress   =  Either a b -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: Either a b -> Maybe [[Expr]]
conjureTiers     =  Either a b -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: Either a b -> Reification
conjureSubTypes Either a b
elr  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
l Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
r
    where
    Left a
l   =  Either a b
elr
    Right b
r  =  Either a b
elr
  conjureCases :: Either a b -> [Expr]
conjureCases Either a b
exy  =  [ String -> (a -> Either a b) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Left" (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Either a b -> a -> Either a b
forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ Either a b -> Expr
forall a. Typeable a => a -> Expr
hole Either a b
x
                       , String -> (b -> Either a b) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Right" (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Either a b -> b -> Either a b
forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ Either a b -> Expr
forall a. Typeable a => a -> Expr
hole Either a b
y
                       ]
    where
    x :: Either a b
x  =  a -> Either a b
forall a b. a -> Either a b
Left a
forall a. HasCallStack => a
undefined Either a b -> Either a b -> Either a b
forall a. a -> a -> a
-: Either a b
exy
    y :: Either a b
y  =  b -> Either a b
forall a b. b -> Either a b
Right b
forall a. HasCallStack => a
undefined Either a b -> Either a b -> Either a b
forall a. a -> a -> a
-: Either a b
exy
  conjureEquality :: Either a b -> Maybe Expr
conjureEquality Either a b
elr  =  Expr -> Expr -> Expr
from (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
l Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
r
    where
    Left a
l   =  Either a b
elr
    Right b
r  =  Either a b
elr
    from :: Expr -> Expr -> Expr
from Expr
el Expr
er  =  String -> (Either a b -> Either a b -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" Either a b -> Either a b -> Bool
(==)
      where
      ==. :: a -> a -> Bool
(==.)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
el (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
l
      .== :: b -> b -> Bool
(.==)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
er (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
r
      (Left a
x)  == :: Either a b -> Either a b -> Bool
== (Left a
y)   =  a
x a -> a -> Bool
==. a
y
      (Left a
_)  == (Right b
_)  =  Bool
False
      (Right b
_) == (Left a
_)   =  Bool
False
      (Right b
x) == (Right b
y)  =  b
x b -> b -> Bool
.== b
y

instance (Conjurable a, Conjurable b) => Conjurable (a -> b) where
  conjureArgumentHoles :: (a -> b) -> [Expr]
conjureArgumentHoles a -> b
f  =  a -> Expr
forall a. Typeable a => a -> Expr
hole ((a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f) Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: b -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles (a -> b
f a
forall a. HasCallStack => a
undefined)
  conjureSubTypes :: (a -> b) -> Reification
conjureSubTypes a -> b
f  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType ((a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f) Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Reification
forall a. Conjurable a => a -> Reification
conjureType ((a -> b) -> b
forall a b. (a -> b) -> b
resTy a -> b
f)
  conjureIf :: (a -> b) -> Expr
conjureIf a -> b
f  =  b -> Expr
forall a. Conjurable a => a -> Expr
conjureIf (a -> b
f a
forall a. HasCallStack => a
undefined)
  conjureArgumentCases :: (a -> b) -> [[Expr]]
conjureArgumentCases a -> b
f  =  a -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureCases ((a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f) [Expr] -> [[Expr]] -> [[Expr]]
forall a. a -> [a] -> [a]
: b -> [[Expr]]
forall a. Conjurable a => a -> [[Expr]]
conjureArgumentCases (a -> b
f a
forall a. HasCallStack => a
undefined)
  conjureExpress :: (a -> b) -> Expr -> Expr
conjureExpress a -> b
f Expr
e
    | Expr -> TypeRep
typ Expr
e TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf ((a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f)  =  a -> Expr -> Expr
forall a. Conjurable a => a -> Expr -> Expr
conjureExpress ((a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f) Expr
e
    | Bool
otherwise                  =  b -> Expr -> Expr
forall a. Conjurable a => a -> Expr -> Expr
conjureExpress (a -> b
f a
forall a. HasCallStack => a
undefined) Expr
e
  conjureEvaluate :: (Expr -> Expr) -> Int -> Defn -> Expr -> Maybe (a -> b)
conjureEvaluate Expr -> Expr
exprExpr Int
mx Defn
defn Expr
ef  =  Maybe (a -> b)
mf
    where
    ce :: Expr -> Maybe b
ce  =  (Expr -> Expr) -> Int -> Defn -> Expr -> Maybe b
forall a.
Conjurable a =>
(Expr -> Expr) -> Int -> Defn -> Expr -> Maybe a
conjureEvaluate Expr -> Expr
exprExpr Int
mx Defn
defn
    mf :: Maybe (a -> b)
mf  =  case Expr -> Maybe b
ce (Expr -> Expr
holeAsTypeOf Expr
ef Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x) Maybe b -> Maybe b -> Maybe b
forall a. a -> a -> a
-: b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
f a
x) of
           Maybe b
Nothing -> Maybe (a -> b)
forall a. Maybe a
Nothing
           Just b
_  -> (a -> b) -> Maybe (a -> b)
forall a. a -> Maybe a
Just ((a -> b) -> Maybe (a -> b)) -> (a -> b) -> Maybe (a -> b)
forall a b. (a -> b) -> a -> b
$ \a
x -> b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
forall a. a
err (Maybe b -> b) -> (Expr -> Maybe b) -> Expr -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe b
ce (Expr -> b) -> Expr -> b
forall a b. (a -> b) -> a -> b
$ Expr
ef Expr -> Expr -> Expr
:$ Expr -> Expr
exprExpr (String -> a -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"" a
x)
    f :: a -> b
f  =  a -> b
forall a. HasCallStack => a
undefined (a -> b) -> (a -> b) -> a -> b
forall a. a -> a -> a
-: Maybe (a -> b) -> a -> b
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (a -> b)
mf
    x :: a
x  =  (a -> b) -> a
forall a b. (a -> b) -> a
argTy a -> b
f
    err :: a
err  =  String -> a
forall a. HasCallStack => String -> a
error String
"conjureEvaluate (a->b): BUG!  This should never be evaluated as it is protected by the outer case."

argTy :: (a -> b) -> a
argTy :: (a -> b) -> a
argTy a -> b
_  =  a
forall a. HasCallStack => a
undefined

resTy :: (a -> b) -> b
resTy :: (a -> b) -> b
resTy a -> b
_  =  b
forall a. HasCallStack => a
undefined

-- | Evaluates a 'Defn' into a regular Haskell value
--   returning 'Nothing' when there's a type mismatch.
--
-- The integer argument indicates the limit of recursive evaluations.
cevaluate :: Conjurable f => Int -> Defn -> Maybe f
cevaluate :: Int -> Defn -> Maybe f
cevaluate Int
mx Defn
defn  =  Maybe f
mr
  where
  mr :: Maybe f
mr  =  (Expr -> Expr) -> Int -> Defn -> Expr -> Maybe f
forall a.
Conjurable a =>
(Expr -> Expr) -> Int -> Defn -> Expr -> Maybe a
conjureEvaluate Expr -> Expr
exprExpr Int
mx Defn
defn Expr
ef'
  exprExpr :: Expr -> Expr
exprExpr  =  f -> Expr -> Expr
forall a. Conjurable a => a -> Expr -> Expr
conjureExpress (f -> Expr -> Expr) -> f -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Maybe f -> f
forall a. HasCallStack => Maybe a -> a
fromJust Maybe f
mr
  (Expr
ef':[Expr]
_)  =  Expr -> [Expr]
unfoldApp (Expr -> [Expr])
-> ((Expr, Expr) -> Expr) -> (Expr, Expr) -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Expr) -> Expr
forall a b. (a, b) -> a
fst ((Expr, Expr) -> [Expr]) -> (Expr, Expr) -> [Expr]
forall a b. (a -> b) -> a -> b
$ Defn -> (Expr, Expr)
forall a. [a] -> a
head Defn
defn

-- | Evaluates a 'Defn' into a regular Haskell value
--   returning the given default value when there's a type mismatch.
--
-- The integer argument indicates the limit of recursive evaluations.
ceval :: Conjurable f => Int -> f -> Defn -> f
ceval :: Int -> f -> Defn -> f
ceval Int
mx f
z  =  f -> Maybe f -> f
forall a. a -> Maybe a -> a
fromMaybe f
z (Maybe f -> f) -> (Defn -> Maybe f) -> Defn -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Defn -> Maybe f
forall f. Conjurable f => Int -> Defn -> Maybe f
cevaluate Int
mx

-- | Evaluates a 'Defn' into a regular Haskell value
--   raising an error there's a type mismatch.
--
-- The integer argument indicates the limit of recursive evaluations.
cevl :: Conjurable f => Int -> Defn -> f
cevl :: Int -> Defn -> f
cevl Int
mx  =  Int -> f -> Defn -> f
forall f. Conjurable f => Int -> f -> Defn -> f
ceval Int
mx f
forall a. a
err
  where
  err :: a
err  =  String -> a
forall a. HasCallStack => String -> a
error String
"cevl: type mismatch"

-- | Computes a complete application for the given function.
--
-- > > conjureApplication "not" not
-- > not p :: Bool
--
-- > > conjureApplication "+" ((+) :: Int -> Int -> Int)
-- > x + y :: Int
--
-- (cf. 'conjureVarApplication')
conjureApplication :: Conjurable f => String -> f -> Expr
conjureApplication :: String -> f -> Expr
conjureApplication  =  (String -> f -> Expr) -> String -> f -> Expr
forall f.
Conjurable f =>
(String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication String -> f -> Expr
forall a. Typeable a => String -> a -> Expr
value

-- | Computes a complete application for a variable
--   of the same type of the given function.
--
-- > > conjureVarApplication "not" not
-- > not p :: Bool
--
-- > > conjureVarApplication "+" ((+) :: Int -> Int -> Int)
-- > x + y :: Int
--
-- (cf. 'conjureApplication')
conjureVarApplication :: Conjurable f => String -> f -> Expr
conjureVarApplication :: String -> f -> Expr
conjureVarApplication  =  (String -> f -> Expr) -> String -> f -> Expr
forall f.
Conjurable f =>
(String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication String -> f -> Expr
forall a. Typeable a => String -> a -> Expr
var

-- | Used in the implementation of 'conjureApplication' and 'conjureVarApplication'.
conjureWhatApplication :: Conjurable f => (String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication :: (String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication String -> f -> Expr
what String
nm f
f  =  Expr -> Expr
mostGeneralCanonicalVariation (Expr -> Expr) -> ([Expr] -> Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr
foldApp
                                  ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$  String -> f -> Expr
what String
nf f
f Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: (String -> Expr -> Expr) -> [String] -> [Expr] -> [Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Expr -> Expr
varAsTypeOf [String]
nas (f -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f)
  where
  (String
nf:[String]
nas)  =  String -> [String]
words String
nm [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat String
""

-- | Computes tiers of sets of patterns for the given function.
--
-- > > conjurePats [zero] "f" (undefined :: Int -> Int)
-- > [[[f x :: Int]],[[f 0 :: Int,f x :: Int]]]
conjurePats :: Conjurable f => [Expr] -> String -> f -> [[ [Expr] ]]
conjurePats :: [Expr] -> String -> f -> [[[Expr]]]
conjurePats [Expr]
es String
nm f
f  =  ([[Expr]] -> [Expr]) -> [[[[Expr]]]] -> [[[Expr]]]
forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (([Expr] -> Expr) -> [[Expr]] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Expr
mkApp ([[Expr]] -> [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
prods) ([[[[Expr]]]] -> [[[Expr]]]) -> [[[[Expr]]]] -> [[[Expr]]]
forall a b. (a -> b) -> a -> b
$ [[[[Expr]]]]
cs
  where
  mkApp :: [Expr] -> Expr
mkApp  =  [Expr] -> Expr
foldApp ([Expr] -> Expr) -> ([Expr] -> [Expr]) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr
efExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:)
         ([Expr] -> [Expr]) -> ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Expr -> [Expr]
unfold
         (Expr -> [Expr]) -> ([Expr] -> Expr) -> [Expr] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  f -> Expr -> Expr
forall a. Conjurable a => a -> Expr -> Expr
conjureMostGeneralCanonicalVariation f
f
         (Expr -> Expr) -> ([Expr] -> Expr) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Expr] -> Expr
fold
  ef :: Expr
ef  =  String -> f -> Expr
forall a. Typeable a => String -> a -> Expr
var ([String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
nm) f
f  -- TODO: take the tail into account
  cs :: [[[[Expr]]]]
cs  =  [[[[Expr]]]] -> [[[[Expr]]]]
forall a. [[[a]]] -> [[[a]]]
products ([[[[Expr]]]] -> [[[[Expr]]]]) -> [[[[Expr]]]] -> [[[[Expr]]]]
forall a b. (a -> b) -> a -> b
$ (Expr -> [Expr] -> [[[Expr]]])
-> [Expr] -> [[Expr]] -> [[[[Expr]]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expr -> [Expr] -> [[[Expr]]]
mk (f -> [Expr]
forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f) (f -> [[Expr]]
forall a. Conjurable a => a -> [[Expr]]
conjureArgumentCases f
f)
  mk :: Expr -> [Expr] -> [[[Expr]]]
mk Expr
h []  =  ([Expr] -> [Expr]) -> [[[Expr]]] -> [[[Expr]]]
forall a b. (a -> b) -> [[a]] -> [[b]]
mapT ([Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr
h]) ([[[Expr]]] -> [[[Expr]]]) -> [[[Expr]]] -> [[[Expr]]]
forall a b. (a -> b) -> a -> b
$ [[Expr]] -> [[[Expr]]]
forall a. [[a]] -> [[[a]]]
setsOf [[Expr
e] | Expr
e <- [Expr]
es, Expr -> TypeRep
typ Expr
e TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
h]
  mk Expr
h [Expr]
cs  =  [[[Expr
h]], [[Expr]
cs]]
  tiersFor :: Expr -> [[Expr]]
tiersFor  =  f -> Expr -> [[Expr]]
forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f

prods :: [[a]] -> [[a]]
prods :: [[a]] -> [[a]]
prods  =  ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> [a] -> [a]) -> [a] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
productWith (:)) [[]]
  where
  productWith :: (t -> t -> a) -> [t] -> [t] -> [a]
productWith t -> t -> a
(?) [t]
xs [t]
ys  =  [t
x t -> t -> a
? t
y | t
x <- [t]
xs, t
y <- [t]
ys]


-- -- -- other Conjurable instances -- -- --

instance Conjurable Ordering where
  conjureExpress :: Ordering -> Expr -> Expr
conjureExpress   =  Ordering -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Ordering -> Maybe Expr
conjureEquality  =  Ordering -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Ordering -> Maybe [[Expr]]
conjureTiers     =  Ordering -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers

instance Conjurable Float where
  conjureExpress :: Float -> Expr -> Expr
conjureExpress   =  Float -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Float -> Maybe Expr
conjureEquality  =  Float -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Float -> Maybe [[Expr]]
conjureTiers     =  Float -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Float -> Int
conjureSize      =  Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round

instance Conjurable Double where
  conjureExpress :: Double -> Expr -> Expr
conjureExpress   =  Double -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Double -> Maybe Expr
conjureEquality  =  Double -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Double -> Maybe [[Expr]]
conjureTiers     =  Double -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Double -> Int
conjureSize      =  Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round

instance Conjurable Int8 where
  conjureExpress :: Int8 -> Expr -> Expr
conjureExpress   =  Int8 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Int8 -> Maybe Expr
conjureEquality  =  Int8 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Int8 -> Maybe [[Expr]]
conjureTiers     =  Int8 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Int8 -> Int
conjureSize      =  Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> (Int8 -> Int8) -> Int8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int8
forall a. Num a => a -> a
abs

instance Conjurable Int16 where
  conjureExpress :: Int16 -> Expr -> Expr
conjureExpress   =  Int16 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Int16 -> Maybe Expr
conjureEquality  =  Int16 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Int16 -> Maybe [[Expr]]
conjureTiers     =  Int16 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Int16 -> Int
conjureSize      =  Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> (Int16 -> Int16) -> Int16 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int16
forall a. Num a => a -> a
abs

instance Conjurable Int32 where
  conjureExpress :: Int32 -> Expr -> Expr
conjureExpress   =  Int32 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Int32 -> Maybe Expr
conjureEquality  =  Int32 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Int32 -> Maybe [[Expr]]
conjureTiers     =  Int32 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Int32 -> Int
conjureSize      =  Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> (Int32 -> Int32) -> Int32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. Num a => a -> a
abs

instance Conjurable Int64 where
  conjureExpress :: Int64 -> Expr -> Expr
conjureExpress   =  Int64 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Int64 -> Maybe Expr
conjureEquality  =  Int64 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Int64 -> Maybe [[Expr]]
conjureTiers     =  Int64 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Int64 -> Int
conjureSize      =  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Int64 -> Int64) -> Int64 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a. Num a => a -> a
abs

instance Conjurable Word where
  conjureExpress :: Word -> Expr -> Expr
conjureExpress   =  Word -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Word -> Maybe Expr
conjureEquality  =  Word -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Word -> Maybe [[Expr]]
conjureTiers     =  Word -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Word -> Int
conjureSize      =  Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (Word -> Word) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word
forall a. Num a => a -> a
abs

instance Conjurable Word8 where
  conjureExpress :: Word8 -> Expr -> Expr
conjureExpress   =  Word8 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Word8 -> Maybe Expr
conjureEquality  =  Word8 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Word8 -> Maybe [[Expr]]
conjureTiers     =  Word8 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Word8 -> Int
conjureSize      =  Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Word8 -> Word8) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
forall a. Num a => a -> a
abs

instance Conjurable Word16 where
  conjureExpress :: Word16 -> Expr -> Expr
conjureExpress   =  Word16 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Word16 -> Maybe Expr
conjureEquality  =  Word16 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Word16 -> Maybe [[Expr]]
conjureTiers     =  Word16 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Word16 -> Int
conjureSize      =  Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> (Word16 -> Word16) -> Word16 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a. Num a => a -> a
abs

instance Conjurable Word32 where
  conjureExpress :: Word32 -> Expr -> Expr
conjureExpress   =  Word32 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Word32 -> Maybe Expr
conjureEquality  =  Word32 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Word32 -> Maybe [[Expr]]
conjureTiers     =  Word32 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Word32 -> Int
conjureSize      =  Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> (Word32 -> Word32) -> Word32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
forall a. Num a => a -> a
abs

instance Conjurable Word64 where
  conjureExpress :: Word64 -> Expr -> Expr
conjureExpress   =  Word64 -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Word64 -> Maybe Expr
conjureEquality  =  Word64 -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Word64 -> Maybe [[Expr]]
conjureTiers     =  Word64 -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Word64 -> Int
conjureSize      =  Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (Word64 -> Word64) -> Word64 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a. Num a => a -> a
abs

instance (Integral a, Conjurable a, Listable a, Show a, Eq a, Express a) => Conjurable (Ratio a) where
  conjureExpress :: Ratio a -> Expr -> Expr
conjureExpress   =  Ratio a -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Ratio a -> Maybe Expr
conjureEquality  =  Ratio a -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Ratio a -> Maybe [[Expr]]
conjureTiers     =  Ratio a -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Ratio a -> Int
conjureSize Ratio a
q    =  a -> Int
forall a. Conjurable a => a -> Int
conjureSize (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Conjurable a => a -> Int
conjureSize (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q)
  conjureSubTypes :: Ratio a -> Reification
conjureSubTypes Ratio a
q  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q)
  conjureCases :: Ratio a -> [Expr]
conjureCases Ratio a
q  =  [String -> (a -> a -> Ratio a) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"%" (a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%) (a -> a -> Ratio a) -> Ratio a -> a -> a -> Ratio a
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: Ratio a
q) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
n Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
d]
    where
    n :: a
n  =  Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q
    d :: a
d  =  Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q

instance (RealFloat a, Conjurable a, Listable a, Show a, Eq a, Express a) => Conjurable (Complex a) where
  conjureExpress :: Complex a -> Expr -> Expr
conjureExpress   =  Complex a -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Complex a -> Maybe Expr
conjureEquality  =  Complex a -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Complex a -> Maybe [[Expr]]
conjureTiers     =  Complex a -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: Complex a -> Int
conjureSize Complex a
x    =  a -> Int
forall a. Conjurable a => a -> Int
conjureSize (Complex a -> a
forall a. Complex a -> a
realPart Complex a
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Conjurable a => a -> Int
conjureSize (Complex a -> a
forall a. Complex a -> a
imagPart Complex a
x)
  conjureSubTypes :: Complex a -> Reification
conjureSubTypes Complex a
x  =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType (Complex a -> a
forall a. Complex a -> a
realPart Complex a
x)


-- Conjurable helper types --
instance Conjurable A where
  conjureExpress :: A -> Expr -> Expr
conjureExpress   =  A -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: A -> Maybe Expr
conjureEquality  =  A -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: A -> Maybe [[Expr]]
conjureTiers     =  A -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: A -> Int
conjureSize      =  A -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (A -> Int) -> (A -> A) -> A -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. A -> A
forall a. Num a => a -> a
abs

instance Conjurable B where
  conjureExpress :: B -> Expr -> Expr
conjureExpress   =  B -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: B -> Maybe Expr
conjureEquality  =  B -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: B -> Maybe [[Expr]]
conjureTiers     =  B -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: B -> Int
conjureSize      =  B -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (B -> Int) -> (B -> B) -> B -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B -> B
forall a. Num a => a -> a
abs

instance Conjurable C where
  conjureExpress :: C -> Expr -> Expr
conjureExpress   =  C -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: C -> Maybe Expr
conjureEquality  =  C -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: C -> Maybe [[Expr]]
conjureTiers     =  C -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: C -> Int
conjureSize      =  C -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (C -> Int) -> (C -> C) -> C -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C -> C
forall a. Num a => a -> a
abs

instance Conjurable D where
  conjureExpress :: D -> Expr -> Expr
conjureExpress   =  D -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: D -> Maybe Expr
conjureEquality  =  D -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: D -> Maybe [[Expr]]
conjureTiers     =  D -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: D -> Int
conjureSize      =  D -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (D -> Int) -> (D -> D) -> D -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D -> D
forall a. Num a => a -> a
abs

instance Conjurable E where
  conjureExpress :: E -> Expr -> Expr
conjureExpress   =  E -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: E -> Maybe Expr
conjureEquality  =  E -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: E -> Maybe [[Expr]]
conjureTiers     =  E -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: E -> Int
conjureSize      =  E -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (E -> Int) -> (E -> E) -> E -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> E
forall a. Num a => a -> a
abs

instance Conjurable F where
  conjureExpress :: F -> Expr -> Expr
conjureExpress   =  F -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: F -> Maybe Expr
conjureEquality  =  F -> Maybe Expr
forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: F -> Maybe [[Expr]]
conjureTiers     =  F -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: F -> Int
conjureSize      =  F -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (F -> Int) -> (F -> F) -> F -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. F -> F
forall a. Num a => a -> a
abs


-- Conjurable tuples --

instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         , Conjurable c, Listable c, Show c, Express c
         , Conjurable d, Listable d, Show d, Express d
         ) => Conjurable (a,b,c,d) where
  conjureExpress :: (a, b, c, d) -> Expr -> Expr
conjureExpress   =  (a, b, c, d) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d) -> Maybe [[Expr]]
conjureTiers     =  (a, b, c, d) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c, d) -> Reification
conjureSubTypes (a, b, c, d)
xyzw =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
                       Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
y
                       Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  c -> Reification
forall a. Conjurable a => a -> Reification
conjureType c
z
                       Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  d -> Reification
forall a. Conjurable a => a -> Reification
conjureType d
w
                       where (a
x,b
y,c
z,d
w) = (a, b, c, d)
xyzw
  conjureEquality :: (a, b, c, d) -> Maybe Expr
conjureEquality (a, b, c, d)
xyzw  =  Expr -> Expr -> Expr -> Expr -> Expr
from
                       (Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                       Maybe (Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                       Maybe (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                       Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
    where
    (a
x,b
y,c
z,d
w)  =  (a, b, c, d)
xyzw
    from :: Expr -> Expr -> Expr -> Expr -> Expr
from Expr
e1 Expr
e2 Expr
e3 Expr
e4  =  String -> ((a, b, c, d) -> (a, b, c, d) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d) -> (a, b, c, d) -> Bool
(==)
      where
      ==... :: a -> a -> Bool
(==...)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==.. :: b -> b -> Bool
(.==..)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==. :: c -> c -> Bool
(..==.)  =  Expr -> c -> c -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e3 (c -> c -> Bool) -> c -> c -> c -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...== :: d -> d -> Bool
(...==)  =  Expr -> d -> d -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e4 (d -> d -> Bool) -> d -> d -> d -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      (a
x1,b
y1,c
z1,d
w1) == :: (a, b, c, d) -> (a, b, c, d) -> Bool
== (a
x2,b
y2,c
z2,d
w2)  =  a
x1 a -> a -> Bool
==... a
x2
                                      Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==.. b
y2
                                      Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==. c
z2
                                      Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...== d
w2

instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         , Conjurable c, Listable c, Show c, Express c
         , Conjurable d, Listable d, Show d, Express d
         , Conjurable e, Listable e, Show e, Express e
         ) => Conjurable (a,b,c,d,e) where
  conjureExpress :: (a, b, c, d, e) -> Expr -> Expr
conjureExpress   =  (a, b, c, d, e) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e) -> Maybe [[Expr]]
conjureTiers     =  (a, b, c, d, e) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c, d, e) -> Reification
conjureSubTypes (a, b, c, d, e)
xyzwv =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
                        Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
y
                        Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  c -> Reification
forall a. Conjurable a => a -> Reification
conjureType c
z
                        Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  d -> Reification
forall a. Conjurable a => a -> Reification
conjureType d
w
                        Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  e -> Reification
forall a. Conjurable a => a -> Reification
conjureType e
v
                        where (a
x,b
y,c
z,d
w,e
v) = (a, b, c, d, e)
xyzwv
  conjureEquality :: (a, b, c, d, e) -> Maybe Expr
conjureEquality (a, b, c, d, e)
xyzwv  =  Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from
                        (Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                        Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                        Maybe (Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                        Maybe (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                        Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality e
v
    where
    (a
x,b
y,c
z,d
w,e
v)  =  (a, b, c, d, e)
xyzwv
    from :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from Expr
e1 Expr
e2 Expr
e3 Expr
e4 Expr
e5  =  String -> ((a, b, c, d, e) -> (a, b, c, d, e) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d, e) -> (a, b, c, d, e) -> Bool
(==)
      where
      ==.... :: a -> a -> Bool
(==....)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==... :: b -> b -> Bool
(.==...)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==.. :: c -> c -> Bool
(..==..)  =  Expr -> c -> c -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e3 (c -> c -> Bool) -> c -> c -> c -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==. :: d -> d -> Bool
(...==.)  =  Expr -> d -> d -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e4 (d -> d -> Bool) -> d -> d -> d -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....== :: e -> e -> Bool
(....==)  =  Expr -> e -> e -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e5 (e -> e -> Bool) -> e -> e -> e -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: e
v
      (a
x1,b
y1,c
z1,d
w1,e
v1) == :: (a, b, c, d, e) -> (a, b, c, d, e) -> Bool
== (a
x2,b
y2,c
z2,d
w2,e
v2)  =  a
x1 a -> a -> Bool
==.... a
x2
                                            Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==... b
y2
                                            Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==.. c
z2
                                            Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...==. d
w2
                                            Bool -> Bool -> Bool
&& e
v1 e -> e -> Bool
....== e
v2

instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         , Conjurable c, Listable c, Show c, Express c
         , Conjurable d, Listable d, Show d, Express d
         , Conjurable e, Listable e, Show e, Express e
         , Conjurable f, Listable f, Show f, Express f
         ) => Conjurable (a,b,c,d,e,f) where
  conjureExpress :: (a, b, c, d, e, f) -> Expr -> Expr
conjureExpress   =  (a, b, c, d, e, f) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e, f) -> Maybe [[Expr]]
conjureTiers     =  (a, b, c, d, e, f) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c, d, e, f) -> Reification
conjureSubTypes (a, b, c, d, e, f)
xyzwvu =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
                         Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
y
                         Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  c -> Reification
forall a. Conjurable a => a -> Reification
conjureType c
z
                         Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  d -> Reification
forall a. Conjurable a => a -> Reification
conjureType d
w
                         Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  e -> Reification
forall a. Conjurable a => a -> Reification
conjureType e
v
                         Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  f -> Reification
forall a. Conjurable a => a -> Reification
conjureType f
u
                         where (a
x,b
y,c
z,d
w,e
v,f
u) = (a, b, c, d, e, f)
xyzwvu
  conjureEquality :: (a, b, c, d, e, f) -> Maybe Expr
conjureEquality (a, b, c, d, e, f)
xyzwvu  =  Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from
                         (Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr
-> Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                         Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                         Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                         Maybe (Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                         Maybe (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality e
v
                         Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality f
u
    where
    (a
x,b
y,c
z,d
w,e
v,f
u)  =  (a, b, c, d, e, f)
xyzwvu
    from :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from Expr
e1 Expr
e2 Expr
e3 Expr
e4 Expr
e5 Expr
e6  =  String
-> ((a, b, c, d, e, f) -> (a, b, c, d, e, f) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> Bool
(==)
      where
      ==..... :: a -> a -> Bool
(==.....)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==.... :: b -> b -> Bool
(.==....)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==... :: c -> c -> Bool
(..==...)  =  Expr -> c -> c -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e3 (c -> c -> Bool) -> c -> c -> c -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==.. :: d -> d -> Bool
(...==..)  =  Expr -> d -> d -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e4 (d -> d -> Bool) -> d -> d -> d -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....==. :: e -> e -> Bool
(....==.)  =  Expr -> e -> e -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e5 (e -> e -> Bool) -> e -> e -> e -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: e
v
      .....== :: f -> f -> Bool
(.....==)  =  Expr -> f -> f -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e6 (f -> f -> Bool) -> f -> f -> f -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: f
u
      (a
x1,b
y1,c
z1,d
w1,e
v1,f
u1) == :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> Bool
== (a
x2,b
y2,c
z2,d
w2,e
v2,f
u2)  =  a
x1 a -> a -> Bool
==..... a
x2
                                                  Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==.... b
y2
                                                  Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==... c
z2
                                                  Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...==.. d
w2
                                                  Bool -> Bool -> Bool
&& e
v1 e -> e -> Bool
....==. e
v2
                                                  Bool -> Bool -> Bool
&& f
u1 f -> f -> Bool
.....== f
u2

instance ( Conjurable a, Listable a, Show a, Express a
         , Conjurable b, Listable b, Show b, Express b
         , Conjurable c, Listable c, Show c, Express c
         , Conjurable d, Listable d, Show d, Express d
         , Conjurable e, Listable e, Show e, Express e
         , Conjurable f, Listable f, Show f, Express f
         , Conjurable g, Listable g, Show g, Express g
         ) => Conjurable (a,b,c,d,e,f,g) where
  conjureExpress :: (a, b, c, d, e, f, g) -> Expr -> Expr
conjureExpress   =  (a, b, c, d, e, f, g) -> Expr -> Expr
forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e, f, g) -> Maybe [[Expr]]
conjureTiers     =  (a, b, c, d, e, f, g) -> Maybe [[Expr]]
forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c, d, e, f, g) -> Reification
conjureSubTypes (a, b, c, d, e, f, g)
xyzwvut =  a -> Reification
forall a. Conjurable a => a -> Reification
conjureType a
x
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  b -> Reification
forall a. Conjurable a => a -> Reification
conjureType b
y
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  c -> Reification
forall a. Conjurable a => a -> Reification
conjureType c
z
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  d -> Reification
forall a. Conjurable a => a -> Reification
conjureType d
w
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  e -> Reification
forall a. Conjurable a => a -> Reification
conjureType e
v
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  f -> Reification
forall a. Conjurable a => a -> Reification
conjureType f
u
                          Reification -> Reification -> Reification
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  g -> Reification
forall a. Conjurable a => a -> Reification
conjureType g
t
                         where (a
x,b
y,c
z,d
w,e
v,f
u,g
t) = (a, b, c, d, e, f, g)
xyzwvut
  conjureEquality :: (a, b, c, d, e, f, g) -> Maybe Expr
conjureEquality (a, b, c, d, e, f, g)
xyzwvut  =  Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from
                          (Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr
-> Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                          Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr
-> Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                          Maybe (Expr -> Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                          Maybe (Expr -> Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                          Maybe (Expr -> Expr -> Expr -> Expr)
-> Maybe Expr -> Maybe (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality e
v
                          Maybe (Expr -> Expr -> Expr) -> Maybe Expr -> Maybe (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality f
u
                          Maybe (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g -> Maybe Expr
forall a. Conjurable a => a -> Maybe Expr
conjureEquality g
t
    where
    (a
x,b
y,c
z,d
w,e
v,f
u,g
t)  =  (a, b, c, d, e, f, g)
xyzwvut
    from :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
from Expr
e1 Expr
e2 Expr
e3 Expr
e4 Expr
e5 Expr
e6 Expr
e7  =  String
-> ((a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> Bool) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> Bool
(==)
      where
      ==...... :: a -> a -> Bool
(==......)  =  Expr -> a -> a -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e1 (a -> a -> Bool) -> a -> a -> a -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==..... :: b -> b -> Bool
(.==.....)  =  Expr -> b -> b -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e2 (b -> b -> Bool) -> b -> b -> b -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==.... :: c -> c -> Bool
(..==....)  =  Expr -> c -> c -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e3 (c -> c -> Bool) -> c -> c -> c -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==... :: d -> d -> Bool
(...==...)  =  Expr -> d -> d -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e4 (d -> d -> Bool) -> d -> d -> d -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....==.. :: e -> e -> Bool
(....==..)  =  Expr -> e -> e -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e5 (e -> e -> Bool) -> e -> e -> e -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: e
v
      .....==. :: f -> f -> Bool
(.....==.)  =  Expr -> f -> f -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e6 (f -> f -> Bool) -> f -> f -> f -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: f
u
      ......== :: g -> g -> Bool
(......==)  =  Expr -> g -> g -> Bool
forall a. Typeable a => Expr -> a
evl Expr
e7 (g -> g -> Bool) -> g -> g -> g -> Bool
forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: g
t
      (a
x1,b
y1,c
z1,d
w1,e
v1,f
u1,g
t1) == :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> Bool
== (a
x2,b
y2,c
z2,d
w2,e
v2,f
u2,g
t2)  =  a
x1 a -> a -> Bool
==...... a
x2
                                                        Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==..... b
y2
                                                        Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==.... c
z2
                                                        Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...==... d
w2
                                                        Bool -> Bool -> Bool
&& e
v1 e -> e -> Bool
....==.. e
v2
                                                        Bool -> Bool -> Bool
&& f
u1 f -> f -> Bool
.....==. f
u2
                                                        Bool -> Bool -> Bool
&& g
t1 g -> g -> Bool
......== g
t2

-- TODO: go up to 12-tuples

instance Name A
instance Name B
instance Name C
instance Name D
instance Name E
instance Name F