-- |
-- Module      : Data.Express.Express
-- Copyright   : (c) 2019-2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Defines the 'Express' type class.
{-# LANGUAGE CPP #-}
module Data.Express.Express
  ( Express (..)
  , (-:)
  , (->:)
  , (->>:)
  , (->>>:)
  , (->>>>:)
  , (->>>>>:)
  , (->>>>>>:)
  , (->>>>>>>:)
  , (->>>>>>>>:)
  , (->>>>>>>>>:)
  , (->>>>>>>>>>:)
  , (->>>>>>>>>>>:)
  , (->>>>>>>>>>>>:)
  )
where

import Data.Express.Core
import Data.Typeable

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

-- |
-- 'Express' typeclass instances provide an 'expr' function
-- that allows values to be deeply encoded as applications of 'Expr's.
--
-- > expr False  =  val False
-- > expr (Just True)  =  value "Just" (Just :: Bool -> Maybe Bool) :$ val True
--
-- The function 'expr' can be contrasted with the function 'val':
--
-- * 'val' always encodes values as atomic 'Value' 'Expr's --
--   shallow encoding.
-- * 'expr' ideally encodes expressions as applications (':$')
--   between 'Value' 'Expr's --
--   deep encoding.
--
-- Depending on the situation, one or the other may be desirable.
--
-- Instances can be automatically derived using the TH function
-- 'Data.Express.Express.Derive.deriveExpress'.
--
-- The following example shows a datatype and its instance:
--
-- > data Stack a = Stack a (Stack a) | Empty
--
-- > instance Express a => Express (Stack a) where
-- >   expr s@(Stack x y) = value "Stack" (Stack ->>: s) :$ expr x :$ expr y
-- >   expr s@Empty       = value "Empty" (Empty   -: s)
--
-- To declare 'expr' it may be useful to use auxiliary type binding operators:
-- '-:', '->:', '->>:', '->>>:', '->>>>:', '->>>>>:', ...
--
-- For types with atomic values, just declare @ expr = val @
class (Show a, Typeable a) => Express a where
  expr :: a -> Expr

instance Express ()        where  expr :: () -> Expr
expr  =  () -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Bool      where  expr :: Bool -> Expr
expr  =  Bool -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Int       where  expr :: Int -> Expr
expr  =  Int -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Integer   where  expr :: Integer -> Expr
expr  =  Integer -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Char      where  expr :: Char -> Expr
expr  =  Char -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Ordering  where  expr :: Ordering -> Expr
expr  =  Ordering -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val

instance Express a => Express (Maybe a) where
  expr :: Maybe a -> Expr
expr mx :: Maybe a
mx@Maybe a
Nothing   =  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)
  expr mx :: Maybe a
mx@(Just a
x)  =  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
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x

instance (Express a, Express b) => Express (Either a b) where
  expr :: Either a b -> Expr
expr lx :: Either a b
lx@(Left a
x)   =  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
lx) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x
  expr ry :: Either a b
ry@(Right b
y)  =  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
ry) Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y

instance (Express a, Express b) => Express (a,b) where
  expr :: (a, b) -> Expr
expr (a
x,b
y)  =  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
x,b
y))
              Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y

instance (Express a, Express b, Express c) => Express (a,b,c) where
  expr :: (a, b, c) -> Expr
expr (a
x,b
y,c
z)  =  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
x,b
y,c
z))
                Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z

instance (Express a, Express b, Express c, Express d) => Express (a,b,c,d) where
  expr :: (a, b, c, d) -> Expr
expr (a
x,b
y,c
z,d
w)  =  String -> (a -> b -> c -> d -> (a, b, c, d)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,," ((,,,) (a -> b -> c -> d -> (a, b, c, d))
-> (a, b, c, d) -> a -> b -> c -> d -> (a, b, c, d)
forall a b c d e.
(a -> b -> c -> d -> e) -> e -> a -> b -> c -> d -> e
->>>>: (a
x,b
y,c
z,d
w))
                  Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w

instance Express a => Express [a] where
  expr :: [a] -> Expr
expr [a]
xs  =  case [a]
xs of
              [] -> [a] -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val [a]
xs
              (a
y:[a]
ys) -> 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. Express a => a -> Expr
expr a
y Expr -> Expr -> Expr
:$ [a] -> Expr
forall a. Express a => a -> Expr
expr [a]
ys


-- instances of further types and arities --

instance (Integral a, Express a) => Express (Ratio a) where
  expr :: Ratio a -> Expr
expr 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. Express a => a -> Expr
expr (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
q) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
q)
-- the "Integral a" restriction above is required for compilation on GHC <= 7.10

instance (RealFloat a, Express a) => Express (Complex a) where
  expr :: Complex a -> Expr
expr (a
x :+ a
y)  =  String -> (a -> a -> Complex a) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
":+" (a -> a -> Complex a
forall a. a -> a -> Complex a
(:+) (a -> a -> Complex a) -> Complex a -> a -> a -> Complex a
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: (a
x a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
y)) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
y

instance (Express a, Express b, Express c, Express d, Express e)
      => Express (a,b,c,d,e) where
  expr :: (a, b, c, d, e) -> Expr
expr (a
x,b
y,c
z,d
w,e
v)  =  String -> (a -> b -> c -> d -> e -> (a, b, c, d, e)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,," ((,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> (a, b, c, d, e) -> a -> b -> c -> d -> e -> (a, b, c, d, e)
forall a b c d e f.
(a -> b -> c -> d -> e -> f) -> f -> a -> b -> c -> d -> e -> f
->>>>>: (a
x,b
y,c
z,d
w,e
v))
                    Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v

instance (Express a, Express b, Express c, Express d, Express e, Express f)
      => Express (a,b,c,d,e,f) where
  expr :: (a, b, c, d, e, f) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u)  =  String
-> (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,," ((,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> (a, b, c, d, e, f)
-> a
-> b
-> c
-> d
-> e
-> f
-> (a, b, c, d, e, f)
forall a b c d e f g.
(a -> b -> c -> d -> e -> f -> g)
-> g -> a -> b -> c -> d -> e -> f -> g
->>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u))
                    Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u

instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g )
      => Express (a,b,c,d,e,f,g) where
  expr :: (a, b, c, d, e, f, g) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t)  =  String
-> (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,," ((,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> (a, b, c, d, e, f, g)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> (a, b, c, d, e, f, g)
forall a b c d e f g h.
(a -> b -> c -> d -> e -> f -> g -> h)
-> h -> a -> b -> c -> d -> e -> f -> g -> h
->>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t))
                        Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
                        Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t

#if __GLASGOW_HASKELL__ < 710
-- No 8-tuples for you:
-- On GHC 7.8, 8-tuples are not Typeable instances.
-- We could add a standalone deriving clause,
-- but that may cause trouble
-- if some other library does the same (orphan instance).
-- User should declare Express 8-tuples manually
-- when using GHC <= 7.8.
#else
instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g, Express h )
      => Express (a,b,c,d,e,f,g,h) where
  expr :: (a, b, c, d, e, f, g, h) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s)  =
    String
-> (a
    -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,,," ((,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> (a, b, c, d, e, f, g, h)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> (a, b, c, d, e, f, g, h)
forall a b c d e f g h i.
(a -> b -> c -> d -> e -> f -> g -> h -> i)
-> i -> a -> b -> c -> d -> e -> f -> g -> h -> i
->>>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s))
      Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
      Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t Expr -> Expr -> Expr
:$ h -> Expr
forall a. Express a => a -> Expr
expr h
s

instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g, Express h, Express i )
      => Express (a,b,c,d,e,f,g,h,i) where
  expr :: (a, b, c, d, e, f, g, h, i) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r)  =
    String
-> (a
    -> b
    -> c
    -> d
    -> e
    -> f
    -> g
    -> h
    -> i
    -> (a, b, c, d, e, f, g, h, i))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,,,," ((,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> (a, b, c, d, e, f, g, h, i)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> (a, b, c, d, e, f, g, h, i)
forall a b c d e f g h i j.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
->>>>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r))
      Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
      Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t Expr -> Expr -> Expr
:$ h -> Expr
forall a. Express a => a -> Expr
expr h
s
      Expr -> Expr -> Expr
:$ i -> Expr
forall a. Express a => a -> Expr
expr i
r

instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g, Express h, Express i, Express j )
      => Express (a,b,c,d,e,f,g,h,i,j) where
  expr :: (a, b, c, d, e, f, g, h, i, j) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q)  =
    String
-> (a
    -> b
    -> c
    -> d
    -> e
    -> f
    -> g
    -> h
    -> i
    -> j
    -> (a, b, c, d, e, f, g, h, i, j))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,,,,," ((,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> (a, b, c, d, e, f, g, h, i, j)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j)
forall a b c d e f g h i j k.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
->>>>>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q))
      Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
      Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t Expr -> Expr -> Expr
:$ h -> Expr
forall a. Express a => a -> Expr
expr h
s
      Expr -> Expr -> Expr
:$ i -> Expr
forall a. Express a => a -> Expr
expr i
r Expr -> Expr -> Expr
:$ j -> Expr
forall a. Express a => a -> Expr
expr j
q

instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g, Express h, Express i, Express j, Express k )
      => Express (a,b,c,d,e,f,g,h,i,j,k) where
  expr :: (a, b, c, d, e, f, g, h, i, j, k) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q,k
p)  =
    String
-> (a
    -> b
    -> c
    -> d
    -> e
    -> f
    -> g
    -> h
    -> i
    -> j
    -> k
    -> (a, b, c, d, e, f, g, h, i, j, k))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,,,,,," ((,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> (a, b, c, d, e, f, g, h, i, j, k)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> (a, b, c, d, e, f, g, h, i, j, k)
forall a b c d e f g h i j k l.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> l -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
->>>>>>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q,k
p))
      Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
      Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t Expr -> Expr -> Expr
:$ h -> Expr
forall a. Express a => a -> Expr
expr h
s
      Expr -> Expr -> Expr
:$ i -> Expr
forall a. Express a => a -> Expr
expr i
r Expr -> Expr -> Expr
:$ j -> Expr
forall a. Express a => a -> Expr
expr j
q Expr -> Expr -> Expr
:$ k -> Expr
forall a. Express a => a -> Expr
expr k
p

instance ( Express a, Express b, Express c, Express d, Express e, Express f
         , Express g, Express h, Express i, Express j, Express k, Express l )
      => Express (a,b,c,d,e,f,g,h,i,j,k,l) where
  expr :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Expr
expr (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q,k
p,l
o)  =
    String
-> (a
    -> b
    -> c
    -> d
    -> e
    -> f
    -> g
    -> h
    -> i
    -> j
    -> k
    -> l
    -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Expr
forall a. Typeable a => String -> a -> Expr
value String
",,,,,,,,,,," ((,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b c d e f g h i j k l m.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> m
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
->>>>>>>>>>>>: (a
x,b
y,c
z,d
w,e
v,f
u,g
t,h
s,i
r,j
q,k
p,l
o))
      Expr -> Expr -> Expr
:$ a -> Expr
forall a. Express a => a -> Expr
expr a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Express a => a -> Expr
expr b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Express a => a -> Expr
expr c
z Expr -> Expr -> Expr
:$ d -> Expr
forall a. Express a => a -> Expr
expr d
w
      Expr -> Expr -> Expr
:$ e -> Expr
forall a. Express a => a -> Expr
expr e
v Expr -> Expr -> Expr
:$ f -> Expr
forall a. Express a => a -> Expr
expr f
u Expr -> Expr -> Expr
:$ g -> Expr
forall a. Express a => a -> Expr
expr g
t Expr -> Expr -> Expr
:$ h -> Expr
forall a. Express a => a -> Expr
expr h
s
      Expr -> Expr -> Expr
:$ i -> Expr
forall a. Express a => a -> Expr
expr i
r Expr -> Expr -> Expr
:$ j -> Expr
forall a. Express a => a -> Expr
expr j
q Expr -> Expr -> Expr
:$ k -> Expr
forall a. Express a => a -> Expr
expr k
p Expr -> Expr -> Expr
:$ l -> Expr
forall a. Express a => a -> Expr
expr l
o
#endif

instance Express Double   where  expr :: Double -> Expr
expr  =  Double -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Float    where  expr :: Float -> Expr
expr  =  Float -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Int8     where  expr :: Int8 -> Expr
expr  =  Int8 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Int16    where  expr :: Int16 -> Expr
expr  =  Int16 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Int32    where  expr :: Int32 -> Expr
expr  =  Int32 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Int64    where  expr :: Int64 -> Expr
expr  =  Int64 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Word     where  expr :: Word -> Expr
expr  =  Word -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Word8    where  expr :: Word8 -> Expr
expr  =  Word8 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Word16   where  expr :: Word16 -> Expr
expr  =  Word16 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Word32   where  expr :: Word32 -> Expr
expr  =  Word32 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
instance Express Word64   where  expr :: Word64 -> Expr
expr  =  Word64 -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
#if __GLASGOW_HASKELL__ < 710
-- No GeneralCategory for you:
-- On GHC 7.8, GeneralCategory is not a Typeable instance.
-- We could add a standalone deriving clause,
-- but that may cause trouble
-- if some other library does the same (orphan instance).
-- Users should declare their own Express GeneralCategory instance
-- when using GHC <= 7.8.
#else
instance Express GeneralCategory  where  expr :: GeneralCategory -> Expr
expr  =  GeneralCategory -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val
#endif


-- type binding utilities --

-- | Type restricted version of 'const'
-- that forces its first argument
-- to have the same type as the second.
--
-- >  value -: (undefined :: Ty)  =  value :: Ty
(-:) :: a -> a -> a
-: :: a -> a -> a
(-:) = a -> a -> a
forall a. a -> a -> a
asTypeOf -- const
infixl 1 -:

-- | Type restricted version of 'const'
-- that forces the result of its first argument
-- to have the same type as the second.
--
-- >  f ->: (undefined :: Ty)  =  f :: a -> Ty
(->:) :: (a -> b) -> b -> (a -> b)
->: :: (a -> b) -> b -> a -> b
(->:) = (a -> b) -> b -> a -> b
forall a b. a -> b -> a
const
infixl 1 ->:

-- | Type restricted version of 'const'
-- that forces the result of the result of its first argument
-- to have the same type as the second.
--
-- > f ->>: (undefined :: Ty)  =  f :: a -> b -> Ty
(->>:) :: (a -> b -> c) -> c -> (a -> b -> c)
->>: :: (a -> b -> c) -> c -> a -> b -> c
(->>:) = (a -> b -> c) -> c -> a -> b -> c
forall a b. a -> b -> a
const
infixl 1 ->>:

-- | Type restricted version of 'const'
-- that forces the result of the result of the result of its first argument
-- to have the same type as the second.
(->>>:) :: (a -> b -> c -> d) -> d -> (a -> b -> c -> d)
->>>: :: (a -> b -> c -> d) -> d -> a -> b -> c -> d
(->>>:) = (a -> b -> c -> d) -> d -> a -> b -> c -> d
forall a b. a -> b -> a
const
infixl 1 ->>>:

-- | Forces the result type of a 4-argument function.
(->>>>:) :: (a -> b -> c -> d -> e) -> e -> (a -> b -> c -> d -> e)
->>>>: :: (a -> b -> c -> d -> e) -> e -> a -> b -> c -> d -> e
(->>>>:) = (a -> b -> c -> d -> e) -> e -> a -> b -> c -> d -> e
forall a b. a -> b -> a
const
infixl 1 ->>>>:

-- | Forces the result type of a 5-argument function.
(->>>>>:) :: (a -> b -> c -> d -> e -> f) -> f -> (a -> b -> c -> d -> e -> f)
->>>>>: :: (a -> b -> c -> d -> e -> f) -> f -> a -> b -> c -> d -> e -> f
(->>>>>:) = (a -> b -> c -> d -> e -> f) -> f -> a -> b -> c -> d -> e -> f
forall a b. a -> b -> a
const
infixl 1 ->>>>>:

-- | Forces the result type of a 6-argument function.
(->>>>>>:) :: (a->b->c->d->e->f->g) -> g -> (a->b->c->d->e->f->g)
->>>>>>: :: (a -> b -> c -> d -> e -> f -> g)
-> g -> a -> b -> c -> d -> e -> f -> g
(->>>>>>:) = (a -> b -> c -> d -> e -> f -> g)
-> g -> a -> b -> c -> d -> e -> f -> g
forall a b. a -> b -> a
const
infixl 1 ->>>>>>:

-- | Forces the result type of a 7-argument function.
(->>>>>>>:) :: (a->b->c->d->e->f->g->h) -> h -> (a->b->c->d->e->f->g->h)
->>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h)
-> h -> a -> b -> c -> d -> e -> f -> g -> h
(->>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h)
-> h -> a -> b -> c -> d -> e -> f -> g -> h
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>:

-- | Forces the result type of a 8-argument function.
(->>>>>>>>:) :: (a->b->c->d->e->f->g->h->i) -> i -> (a->b->c->d->e->f->g->h->i)
->>>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h -> i)
-> i -> a -> b -> c -> d -> e -> f -> g -> h -> i
(->>>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h -> i)
-> i -> a -> b -> c -> d -> e -> f -> g -> h -> i
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>>:

-- | Forces the result type of a 9-argument function.
(->>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j) -> j
              -> (a->b->c->d->e->f->g->h->i->j)
->>>>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
(->>>>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h -> i -> j)
-> j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>>>:

-- | Forces the result type of a 10-argument function.
(->>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k) -> k
               -> (a->b->c->d->e->f->g->h->i->j->k)
->>>>>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
(->>>>>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k)
-> k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>>>>:

-- | Forces the result type of a 11-argument function.
(->>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l) -> l
                -> (a->b->c->d->e->f->g->h->i->j->k->l)
->>>>>>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> l -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
(->>>>>>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l)
-> l -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>>>>>:

-- | Forces the result type of a 12-argument function.
(->>>>>>>>>>>>:) :: (a->b->c->d->e->f->g->h->i->j->k->l->m) -> m
                 -> (a->b->c->d->e->f->g->h->i->j->k->l->m)
->>>>>>>>>>>>: :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> m
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
(->>>>>>>>>>>>:) = (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> m
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
forall a b. a -> b -> a
const
infixl 1 ->>>>>>>>>>>>: