-- |
-- 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
  , candidateDeconstructionsFromHoled
  , 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 :: forall a. (Conjurable a, Show a) => a -> Prim
pr a
x  =  (forall a. (Typeable a, Show a) => a -> Expr
val a
x, 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 :: forall a. Conjurable a => String -> a -> Prim
prim String
s a
x  =  (forall a. Typeable a => String -> a -> Expr
value String
s a
x, 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
_  =  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
_  =  forall a. Maybe a
Nothing

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

  -- | Returns an if-function encoded as an 'Expr'.
  conjureIf :: a -> Expr
  conjureIf   =  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  =  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 :: forall a. Conjurable a => a -> Reification
conjureType a
x [Reification1]
ms  =
  if forall a. Typeable a => a -> Expr
hole a
x 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 forall a. Conjurable a => a -> Reification
conjureSubTypes a
x forall a b. (a -> b) -> a -> b
$ forall a. Conjurable a => a -> Reification1
conjureReification1 a
x forall a. a -> [a] -> [a]
: [Reification1]
ms

-- | like 'conjureType' but without type repetitions
nubConjureType :: Conjurable a => a -> Reification
nubConjureType :: forall a. Conjurable a => a -> Reification
nubConjureType a
x  =  forall b a. Eq b => (a -> b) -> [a] -> [a]
nubOn (\(Expr
eh,Maybe Expr
_,Maybe [[Expr]]
_,[String]
_,Bool
_,Expr
_) -> Expr
eh) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Conjurable a => a -> Reification1
conjureReification1 a
x  =  (forall a. Typeable a => a -> Expr
hole a
x, forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x, forall a. Conjurable a => a -> Maybe [[Expr]]
conjureTiers a
x, forall a. Name a => a -> [String]
names a
x, forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Conjurable a => a -> [Expr]
conjureCases a
x, forall a. Typeable a => String -> a -> Expr
value String
"conjureSize" (forall a. Conjurable a => a -> Int
conjureSize 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 :: forall a. Conjurable a => a -> [Reification1]
conjureReification a
x  =  forall a. Conjurable a => a -> Reification
nubConjureType a
x [forall a. Conjurable a => a -> Reification1
conjureReification1 Bool
bool]
  where
  bool :: Bool
  bool :: Bool
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 :: forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality  =  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers  =  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress a
a Expr
e  =  case forall a. Typeable a => String -> a -> Expr
value String
"expr" (forall a. Express a => a -> Expr
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' -> 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 :: forall a. (Listable a, Show a, Typeable a) => a -> [[Expr]]
mkExprTiers a
a  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall a. (Typeable a, Show a) => a -> Expr
val (forall a. Listable a => [[a]]
tiers 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 :: forall a. Conjurable a => a -> [Expr]
conjureHoles f
f  =  [Expr
eh | (Expr
eh,Maybe Expr
_,Just [[Expr]]
_,[String]
_,Bool
_,Expr
_) <- 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 :: forall f. Conjurable f => f -> Expr -> Expr -> Expr
conjureMkEquation f
f  =  [Expr] -> Expr -> Expr -> Expr
mkEquation [Expr
eq | (Expr
_,Just Expr
eq,Maybe [[Expr]]
_,[String]
_,Bool
_,Expr
_) <- forall a. Conjurable a => a -> [Reification1]
conjureReification f
f]

conjureDynamicEq :: Conjurable f => f -> Dynamic
conjureDynamicEq :: forall f. Conjurable f => f -> Dynamic
conjureDynamicEq f
f  =  case 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
_ -> forall a. HasCallStack => String -> a
error String
"conjureDynamicEq: expected an == but found something else.  Bug!"
  where
  efxs :: Expr
efxs  =  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 :: forall f. Conjurable f => f -> Int -> Expr -> Expr -> Bool
conjureAreEqual f
f Int
maxTests  =  Expr -> Expr -> Bool
(===)
  where
  -==- :: Expr -> Expr -> Expr
(-==-)  =  forall f. Conjurable f => f -> Expr -> Expr -> Expr
conjureMkEquation f
f
  Expr
e1 === :: Expr -> Expr -> Bool
=== Expr
e2  =  Expr -> Bool
isTrue forall a b. (a -> b) -> a -> b
$ Expr
e1 Expr -> Expr -> Expr
-==- Expr
e2
  isTrue :: Expr -> Bool
isTrue  =  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
errorToFalse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> Expr -> a
eval Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
gs
  gs :: Expr -> [Expr]
gs  =  forall a. Int -> [a] -> [a]
take Int
maxTests forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (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 :: forall f. Conjurable f => 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
_) <- 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' 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 :: forall f. Conjurable f => f -> Expr -> [String]
conjureNamesFor f
f Expr
e  =  forall a. [a] -> a
head
                     forall a b. (a -> b) -> a -> b
$  [[String]
ns | (Expr
eh, Maybe Expr
_, Maybe [[Expr]]
_, [String]
ns, Bool
_, Expr
_) <- forall a. Conjurable a => a -> [Reification1]
conjureReification f
f, Expr -> TypeRep
typ Expr
e forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
eh]
                     forall a. [a] -> [a] -> [a]
++ [forall a. Name a => a -> [String]
names (forall a. HasCallStack => a
undefined :: Int)] -- use [Int] on lists

conjureMostGeneralCanonicalVariation :: Conjurable f => f -> Expr -> Expr
conjureMostGeneralCanonicalVariation :: forall f. Conjurable f => f -> Expr -> Expr
conjureMostGeneralCanonicalVariation f
f  =  (Expr -> [String]) -> Expr -> Expr
canonicalizeWith (forall f. Conjurable f => f -> Expr -> [String]
conjureNamesFor f
f)
                                        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 :: forall f. Conjurable f => 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) forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
h]
  hs :: [Expr]
hs  =  forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f
  isDec :: Expr -> Bool
isDec Expr
h  =  forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
is [Expr]
gs forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs forall a. Integral a => a -> a -> a
`div` Int
2
    where
    gs :: [Expr]
gs  =  forall a. Int -> [a] -> [a]
take Int
maxTests forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f) Expr
h
    sz :: Expr
sz  =  forall a. [a] -> a
head [Expr
sz | (Expr
_, Maybe Expr
_, Maybe [[Expr]]
_, [String]
_, Bool
_, Expr
sz) <- 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  =  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 forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz (Expr
e Expr -> Expr -> Expr
:$ Expr
e') 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 :: forall f. Conjurable f => f -> Int -> Expr -> Bool
conjureIsDeconstruction f
f Int
maxTests Expr
ed  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expr -> [Expr]
holes Expr
ed) forall a. Eq a => a -> a -> Bool
== Int
1
                                       Bool -> Bool -> Bool
&& Expr -> TypeRep
typ Expr
h forall a. Eq a => a -> a -> Bool
== Expr -> TypeRep
typ Expr
ed
                                       Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
is [Expr]
gs forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs forall a. Integral a => a -> a -> a
`div` Int
2
                                       Bool -> Bool -> Bool
&& forall a. (a -> Bool) -> [a] -> Int
count Expr -> Bool
iz [Expr]
gs forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
gs forall a. Integral a => a -> a -> a
`div` Int
3
  where
  gs :: [Expr]
gs  =  forall a. Int -> [a] -> [a]
take Int
maxTests forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds (forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f) Expr
ed
  [Expr
h]  =  Expr -> [Expr]
holes Expr
ed
  sz :: Expr
sz  =  forall a. [a] -> a
head [Expr
sz | (Expr
_, Maybe Expr
_, Maybe [[Expr]]
_, [String]
_, Bool
_, Expr
sz) <- 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  =  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 forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz Expr
e forall a. Ord a => a -> a -> Bool
<= Expr -> Int
esz (Expr -> Expr
holeValue Expr
e)
  iz :: Expr -> Bool
iz Expr
e  =  Bool -> Bool
errorToFalse forall a b. (a -> b) -> a -> b
$ Expr -> Int
esz Expr
e forall a. Ord a => a -> a -> Bool
< Expr -> Int
esz (Expr -> Expr
holeValue Expr
e)
  holeValue :: Expr -> Expr
holeValue Expr
e  =  forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err
               forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Expr
h
               forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err
               forall a b. (a -> b) -> a -> b
$  Expr
e Expr -> Expr -> Maybe Defn
`match` Expr
ed
  err :: a
err  =  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'
-- followed by 'conjureIsDeconstruction'.
--
-- > > candidateDeconstructionsFrom (xx `mod'` yy)
-- > [ _ `mod` y
-- > , x `mod` _
-- > ]
--
-- To be constrasted with 'candidateDeconstructionsFromHoled'.
candidateDeconstructionsFrom :: Expr -> [Expr]
candidateDeconstructionsFrom :: Expr -> [Expr]
candidateDeconstructionsFrom Expr
e  =
  [ Expr
e'
  | Expr
v <- Expr -> [Expr]
vars Expr
e
  , Expr -> TypeRep
typ Expr
v 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)]
  , forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expr -> [Expr]
holes Expr
e') forall a. Eq a => a -> a -> Bool
== Int
1
  ]

-- | Compute candidate deconstructions from an 'Expr'.
--
-- This is used in the implementation of 'Conjure.Engine.candidateExprs'
-- followed by 'conjureIsDeconstruction'.
--
-- This is similar to 'canonicalVariations'
-- but always leaves a hole
-- of the same return type as the given expression.
--
-- > > candidateDeconstructionsFrom (i_ `mod'` i_)
-- > [ _ `mod` x
-- > , x `mod` _
-- > ]
--
-- To be contrasted with 'candidateDeconstructionsFrom'
candidateDeconstructionsFromHoled :: Expr -> [Expr]
candidateDeconstructionsFromHoled :: Expr -> [Expr]
candidateDeconstructionsFromHoled Expr
e  =  forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Defn -> Expr
//- [(Expr
v, Expr
h)])
                                     forall a b. (a -> b) -> a -> b
$  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [Expr]
canonicalVariations
                                     forall a b. (a -> b) -> a -> b
$  Expr -> Expr -> [Expr]
deholings Expr
v Expr
e
  where
  h :: Expr
h  =  Expr -> Expr
holeAsTypeOf Expr
e
  v :: Expr
v  =  String
"_#_" String -> Expr -> Expr
`varAsTypeOf` Expr
e  -- a marker variable with an invalid name
  -- at some point I should get rid of candidateDeconstructionsFrom in favour
  -- of this one

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

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

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

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

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

instance Conjurable Char where
  conjureExpress :: Char -> Expr -> Expr
conjureExpress   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Char -> Maybe Expr
conjureEquality  =  forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Char -> Maybe [[Expr]]
conjureTiers     =  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)
==: :: forall a. (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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureSubTypes :: [a] -> Reification
conjureSubTypes [a]
xs  =  forall a. Conjurable a => a -> Reification
conjureType (forall a. [a] -> a
head [a]
xs)
  conjureTiers :: [a] -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: [a] -> Int
conjureSize      =  forall (t :: * -> *) a. Foldable t => t a -> Int
length
  conjureCases :: [a] -> [Expr]
conjureCases [a]
xs  =  [ forall a. (Typeable a, Show a) => a -> Expr
val ([] forall a. a -> a -> a
-: [a]
xs)
                      , forall a. Typeable a => String -> a -> Expr
value String
":" ((:) forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: [a]
xs) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole [a]
xs
                      ]  where  x :: a
x  =  forall a. [a] -> a
head [a]
xs
  conjureEquality :: [a] -> Maybe Expr
conjureEquality [a]
xs  =  Expr -> Expr
from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
    where
    x :: a
x  =  forall a. [a] -> a
head [a]
xs
    from :: Expr -> Expr
from Expr
e  =  forall a. Typeable a => String -> a -> Expr
value String
"==" [a] -> [a] -> Bool
(==)
      where
      .==. :: a -> a -> Bool
(.==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b) -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b) -> Reification
conjureSubTypes (a, b)
xy  =  forall a. Conjurable a => a -> Reification
conjureType (forall a b. (a, b) -> a
fst (a, b)
xy)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType (forall a b. (a, b) -> b
snd (a, b)
xy)
  conjureCases :: (a, b) -> [Expr]
conjureCases (a, b)
xy  =  [forall a. Typeable a => String -> a -> Expr
value String
"," ((,) forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: (a, b)
xy) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole b
y]
    where
    (a
x,b
y) = (forall a. HasCallStack => a
undefined,forall a. HasCallStack => a
undefined) forall a. a -> a -> a
-: (a, b)
xy
  conjureEquality :: (a, b) -> Maybe Expr
conjureEquality (a, b)
xy  =  Expr -> Expr -> Expr
from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b) -> (a, b) -> Bool
(==)
      where
      ==. :: a -> a -> Bool
(==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .== :: b -> b -> Bool
(.==)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c) -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c) -> Reification
conjureSubTypes (a, b, c)
xyz =  forall a. Conjurable a => a -> Reification
conjureType a
x
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType b
y
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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  =  [forall a. Typeable a => String -> a -> Expr
value String
",," ((,,) forall a b c d. (a -> b -> c -> d) -> d -> a -> b -> c -> d
->>>: (a, b, c)
xyz) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole b
y Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole c
z]
    where
    (a
x,b
y,c
z) = (forall a. HasCallStack => a
undefined,forall a. HasCallStack => a
undefined,forall a. HasCallStack => a
undefined) 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
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c) -> (a, b, c) -> Bool
(==)
      where
      ==.. :: a -> a -> Bool
(==..)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==. :: b -> b -> Bool
(.==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..== :: c -> c -> Bool
(..==)  =  forall a. Typeable a => Expr -> a
evl Expr
e3 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: Maybe a -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: Maybe a -> Reification
conjureSubTypes Maybe a
mx  =  forall a. Conjurable a => a -> Reification
conjureType (forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mx)
  conjureCases :: Maybe a -> [Expr]
conjureCases Maybe a
mx  =  [ forall a. Typeable a => String -> a -> Expr
value String
"Nothing" (forall a. Maybe a
Nothing forall a. a -> a -> a
-: Maybe a
mx)
                      , forall a. Typeable a => String -> a -> Expr
value String
"Just" (forall a. a -> Maybe a
Just forall a b. (a -> b) -> b -> a -> b
->: Maybe a
mx) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole Maybe a
x
                      ]
    where
    x :: Maybe a
x  =  forall a. a -> Maybe a
Just forall a. HasCallStack => a
undefined forall a. a -> a -> a
-: Maybe a
mx
  conjureEquality :: Maybe a -> Maybe Expr
conjureEquality Maybe a
mx  =  Expr -> Expr
from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
    where
    x :: a
x  =  forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
mx
    from :: Expr -> Expr
from Expr
e  =  forall a. Typeable a => String -> a -> Expr
value String
"==" Maybe a -> Maybe a -> Bool
(==)
      where
      .==. :: a -> a -> Bool
(.==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: Either a b -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: Either a b -> Reification
conjureSubTypes Either a b
elr  =  forall a. Conjurable a => a -> Reification
conjureType a
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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  =  [ forall a. Typeable a => String -> a -> Expr
value String
"Left" (forall a b. a -> Either a b
Left forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole Either a b
x
                       , forall a. Typeable a => String -> a -> Expr
value String
"Right" (forall a b. b -> Either a b
Right forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ forall a. Typeable a => a -> Expr
hole Either a b
y
                       ]
    where
    x :: Either a b
x  =  forall a b. a -> Either a b
Left forall a. HasCallStack => a
undefined forall a. a -> a -> a
-: Either a b
exy
    y :: Either a b
y  =  forall a b. b -> Either a b
Right forall a. HasCallStack => a
undefined forall a. a -> a -> a
-: Either a b
exy
  conjureEquality :: Either a b -> Maybe Expr
conjureEquality Either a b
elr  =  Expr -> Expr -> Expr
from forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
l forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  forall a. Typeable a => String -> a -> Expr
value String
"==" Either a b -> Either a b -> Bool
(==)
      where
      ==. :: a -> a -> Bool
(==.)  =  forall a. Typeable a => Expr -> a
evl Expr
el forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
l
      .== :: b -> b -> Bool
(.==)  =  forall a. Typeable a => Expr -> a
evl Expr
er 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  =  forall a. Typeable a => a -> Expr
hole (forall a b. (a -> b) -> a
argTy a -> b
f) forall a. a -> [a] -> [a]
: forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles (a -> b
f forall a. HasCallStack => a
undefined)
  conjureSubTypes :: (a -> b) -> Reification
conjureSubTypes a -> b
f  =  forall a. Conjurable a => a -> Reification
conjureType (forall a b. (a -> b) -> a
argTy a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Conjurable a => a -> Reification
conjureType (forall a b. (a -> b) -> b
resTy a -> b
f)
  conjureIf :: (a -> b) -> Expr
conjureIf a -> b
f  =  forall a. Conjurable a => a -> Expr
conjureIf (a -> b
f forall a. HasCallStack => a
undefined)
  conjureArgumentCases :: (a -> b) -> [[Expr]]
conjureArgumentCases a -> b
f  =  forall a. Conjurable a => a -> [Expr]
conjureCases (forall a b. (a -> b) -> a
argTy a -> b
f) forall a. a -> [a] -> [a]
: forall a. Conjurable a => a -> [[Expr]]
conjureArgumentCases (a -> b
f forall a. HasCallStack => a
undefined)
  conjureExpress :: (a -> b) -> Expr -> Expr
conjureExpress a -> b
f Expr
e
    | Expr -> TypeRep
typ Expr
e forall a. Eq a => a -> a -> Bool
== forall a. Typeable a => a -> TypeRep
typeOf (forall a b. (a -> b) -> a
argTy a -> b
f)  =  forall f. Conjurable f => f -> Expr -> Expr
conjureExpress (forall a b. (a -> b) -> a
argTy a -> b
f) Expr
e
    | Bool
otherwise                  =  forall f. Conjurable f => f -> Expr -> Expr
conjureExpress (a -> b
f 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  =  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
:$ forall a. Typeable a => a -> Expr
hole a
x) forall a. a -> a -> a
-: forall a. a -> Maybe a
Just (a -> b
f a
x) of
           Maybe b
Nothing -> forall a. Maybe a
Nothing
           Just b
_  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \a
x -> forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe b
ce forall a b. (a -> b) -> a -> b
$ Expr
ef Expr -> Expr -> Expr
:$ Expr -> Expr
exprExpr (forall a. Typeable a => String -> a -> Expr
value String
"" a
x)
    f :: a -> b
f  =  forall a. HasCallStack => a
undefined forall a. a -> a -> a
-: forall a. HasCallStack => Maybe a -> a
fromJust Maybe (a -> b)
mf
    x :: a
x  =  forall a b. (a -> b) -> a
argTy a -> b
f
    err :: a
err  =  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 :: forall a b. (a -> b) -> a
argTy a -> b
_  =  forall a. HasCallStack => a
undefined

resTy :: (a -> b) -> b
resTy :: forall a b. (a -> b) -> b
resTy a -> 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 :: forall f. Conjurable f => Int -> Defn -> Maybe f
cevaluate Int
mx Defn
defn  =  Maybe f
mr
  where
  mr :: Maybe f
mr  =  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  =  forall f. Conjurable f => f -> Expr -> Expr
conjureExpress forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe f
mr
  (Expr
ef':[Expr]
_)  =  Expr -> [Expr]
unfoldApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 :: forall f. Conjurable f => Int -> f -> Defn -> f
ceval Int
mx f
z  =  forall a. a -> Maybe a -> a
fromMaybe f
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall f. Conjurable f => Int -> Defn -> f
cevl Int
mx  =  forall f. Conjurable f => Int -> f -> Defn -> f
ceval Int
mx forall {a}. a
err
  where
  err :: a
err  =  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 :: forall f. Conjurable f => String -> f -> Expr
conjureApplication  =  forall f.
Conjurable f =>
(String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication 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 :: forall f. Conjurable f => String -> f -> Expr
conjureVarApplication  =  forall f.
Conjurable f =>
(String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication 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 :: forall f.
Conjurable f =>
(String -> f -> Expr) -> String -> f -> Expr
conjureWhatApplication String -> f -> Expr
what String
nm f
f  =  Expr -> Expr
mostGeneralCanonicalVariation forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> Expr
foldApp
                                  forall a b. (a -> b) -> a -> b
$  String -> f -> Expr
what String
nf f
f forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Expr -> Expr
varAsTypeOf [String]
nas (forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f)
  where
  (String
nf:[String]
nas)  =  String -> [String]
words String
nm forall a. [a] -> [a] -> [a]
++ 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 :: forall f. Conjurable f => [Expr] -> String -> f -> [[[Expr]]]
conjurePats [Expr]
es String
nm f
f  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Expr
mkApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
prods) forall a b. (a -> b) -> a -> b
$ [[[[Expr]]]]
cs
  where
  mkApp :: [Expr] -> Expr
mkApp  =  [Expr] -> Expr
foldApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr
efforall a. a -> [a] -> [a]
:)
         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Expr -> [Expr]
unfold
         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall f. Conjurable f => f -> Expr -> Expr
conjureMostGeneralCanonicalVariation f
f
         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Expr] -> Expr
fold
  ef :: Expr
ef  =  forall a. Typeable a => String -> a -> Expr
var (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
nm) f
f  -- TODO: take the tail into account
  cs :: [[[[Expr]]]]
cs  =  forall a. [[[a]]] -> [[[a]]]
products forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Expr -> [Expr] -> [[[Expr]]]
mk (forall a. Conjurable a => a -> [Expr]
conjureArgumentHoles f
f) (forall a. Conjurable a => a -> [[Expr]]
conjureArgumentCases f
f)
  mk :: Expr -> [Expr] -> [[[Expr]]]
mk Expr
h []  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT (forall a. [a] -> [a] -> [a]
++ [Expr
h]) forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[[a]]]
setsOf [[Expr
e] | Expr
e <- [Expr]
es, Expr -> TypeRep
typ Expr
e 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  =  forall f. Conjurable f => f -> Expr -> [[Expr]]
conjureTiersFor f
f

prods :: [[a]] -> [[a]]
prods :: forall a. [[a]] -> [[a]]
prods  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: Ordering -> Maybe Expr
conjureEquality  =  forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: Ordering -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

instance Conjurable F where
  conjureExpress :: F -> Expr -> Expr
conjureExpress   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureEquality :: F -> Maybe Expr
conjureEquality  =  forall a. (Eq a, Typeable a) => a -> Maybe Expr
reifyEquality
  conjureTiers :: F -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSize :: F -> Int
conjureSize      =  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d) -> Maybe [[Expr]]
conjureTiers     =  forall a. (Listable a, Show a, Typeable a) => a -> Maybe [[Expr]]
reifyTiers
  conjureSubTypes :: (a, b, c, d) -> Reification
conjureSubTypes (a, b, c, d)
xyzw =  forall a. Conjurable a => a -> Reification
conjureType a
x
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType b
y
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType c
z
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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
                       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d) -> (a, b, c, d) -> Bool
(==)
      where
      ==... :: a -> a -> Bool
(==...)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==.. :: b -> b -> Bool
(.==..)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==. :: c -> c -> Bool
(..==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e3 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...== :: d -> d -> Bool
(...==)  =  forall a. Typeable a => Expr -> a
evl Expr
e4 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e) -> Maybe [[Expr]]
conjureTiers     =  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 =  forall a. Conjurable a => a -> Reification
conjureType a
x
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType b
y
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType c
z
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType d
w
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  forall a. Typeable a => String -> a -> Expr
value String
"==" (a, b, c, d, e) -> (a, b, c, d, e) -> Bool
(==)
      where
      ==.... :: a -> a -> Bool
(==....)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==... :: b -> b -> Bool
(.==...)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==.. :: c -> c -> Bool
(..==..)  =  forall a. Typeable a => Expr -> a
evl Expr
e3 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==. :: d -> d -> Bool
(...==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e4 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....== :: e -> e -> Bool
(....==)  =  forall a. Typeable a => Expr -> a
evl Expr
e5 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e, f) -> Maybe [[Expr]]
conjureTiers     =  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 =  forall a. Conjurable a => a -> Reification
conjureType a
x
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType b
y
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType c
z
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType d
w
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType e
v
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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
                         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality e
v
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  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
(==.....)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==.... :: b -> b -> Bool
(.==....)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==... :: c -> c -> Bool
(..==...)  =  forall a. Typeable a => Expr -> a
evl Expr
e3 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==.. :: d -> d -> Bool
(...==..)  =  forall a. Typeable a => Expr -> a
evl Expr
e4 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....==. :: e -> e -> Bool
(....==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e5 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: e
v
      .....== :: f -> f -> Bool
(.....==)  =  forall a. Typeable a => Expr -> a
evl Expr
e6 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   =  forall a. (Express a, Show a) => a -> Expr -> Expr
reifyExpress
  conjureTiers :: (a, b, c, d, e, f, g) -> Maybe [[Expr]]
conjureTiers     =  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 =  forall a. Conjurable a => a -> Reification
conjureType a
x
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType b
y
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType c
z
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType d
w
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType e
v
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. Conjurable a => a -> Reification
conjureType f
u
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conjurable a => a -> Maybe Expr
conjureEquality a
x
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality b
y
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality c
z
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality d
w
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality e
v
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Conjurable a => a -> Maybe Expr
conjureEquality f
u
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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  =  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
(==......)  =  forall a. Typeable a => Expr -> a
evl Expr
e1 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: a
x
      .==..... :: b -> b -> Bool
(.==.....)  =  forall a. Typeable a => Expr -> a
evl Expr
e2 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: b
y
      ..==.... :: c -> c -> Bool
(..==....)  =  forall a. Typeable a => Expr -> a
evl Expr
e3 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: c
z
      ...==... :: d -> d -> Bool
(...==...)  =  forall a. Typeable a => Expr -> a
evl Expr
e4 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: d
w
      ....==.. :: e -> e -> Bool
(....==..)  =  forall a. Typeable a => Expr -> a
evl Expr
e5 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: e
v
      .....==. :: f -> f -> Bool
(.....==.)  =  forall a. Typeable a => Expr -> a
evl Expr
e6 forall a. (a -> a -> Bool) -> a -> a -> a -> Bool
==: f
u
      ......== :: g -> g -> Bool
(......==)  =  forall a. Typeable a => Expr -> a
evl Expr
e7 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