{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Haskell terms which are interesting
-- to pattern-match when optimizing.
module Symantic.Parser.Haskell where

import Data.Bool (Bool(..))
import Data.Either (Either(..))
import Data.Eq (Eq)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Kind (Type)
import Text.Show (Show(..), showParen, showString)
import qualified Data.Eq as Eq
import qualified Data.Function as Function
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

import Symantic.Univariant.Trans

-- * Type 'ValueCode'
-- | Compile-time 'value' and corresponding 'code'
-- (that can produce that value at runtime).
data ValueCode a = ValueCode
  { forall a. ValueCode a -> Value a
value :: Value a
  , forall a. ValueCode a -> CodeQ a
code :: TH.CodeQ a
  }
getValue :: ValueCode a -> a
getValue :: forall a. ValueCode a -> a
getValue = Value a -> a
forall a. Value a -> a
unValue (Value a -> a) -> (ValueCode a -> Value a) -> ValueCode a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. ValueCode a -> Value a
forall a. ValueCode a -> Value a
value
getCode :: ValueCode a -> TH.CodeQ a
getCode :: forall a. ValueCode a -> CodeQ a
getCode = ValueCode a -> CodeQ a
forall a. ValueCode a -> CodeQ a
code

-- ** Type 'Value'
newtype Value a = Value { forall a. Value a -> a
unValue :: a }

-- * Class 'Haskellable'
-- | Final encoding of some Haskell functions
-- useful for some optimizations in 'optimizeComb'.
class Haskellable (repr :: Type -> Type) where
  (.) :: repr ((b->c) -> (a->b) -> a -> c)
  ($) :: repr ((a->b) -> a -> b)
  (.@) :: repr (a->b) -> repr a -> repr b
  bool :: Bool -> repr Bool
  char :: TH.Lift tok => tok -> repr tok
  cons :: repr (a -> [a] -> [a])
  const :: repr (a -> b -> a)
  eq :: Eq a => repr a -> repr (a -> Bool)
  flip :: repr ((a -> b -> c) -> b -> a -> c)
  id :: repr (a->a)
  nil :: repr [a]
  unit :: repr ()
  left :: repr (l -> Either l r)
  right :: repr (r -> Either l r)
  nothing :: repr (Maybe a)
  just :: repr (a -> Maybe a)

-- ** Type 'Haskellable'
-- | Initial encoding of 'Haskellable'.
data Haskell a where
  Haskell :: ValueCode a -> Haskell a
  (:.) :: Haskell ((b->c) -> (a->b) -> a -> c)
  (:$) :: Haskell ((a->b) -> a -> b)
  (:@) :: Haskell (a->b) -> Haskell a -> Haskell b
  Cons :: Haskell (a -> [a] -> [a])
  Const :: Haskell (a -> b -> a)
  Eq :: Eq a => Haskell a -> Haskell (a -> Bool)
  Flip :: Haskell ((a -> b -> c) -> b -> a -> c)
  Id :: Haskell (a->a)
  Unit :: Haskell ()
infixr 0 $, :$
infixr 9 ., :.
infixl 9 .@, :@

{-
pattern (:.@) ::
  -- Dummy constraint to get the following constraint
  -- in scope when pattern-matching.
  () =>
  ((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) =>
  Haskell x -> Haskell y -> Haskell z
pattern (:.@) f g = (:.) :@ f :@ g
pattern FlipApp ::
  () =>
  ((x -> y) ~ ((a -> b -> c) -> b -> a -> c)) =>
  Haskell x -> Haskell y
pattern FlipApp f = Flip :@ f
pattern FlipConst ::
  () =>
  (x ~ (a -> b -> b)) =>
  Haskell x
pattern FlipConst = FlipApp Const
-}

instance Show (Haskell a) where
  showsPrec :: Int -> Haskell a -> ShowS
showsPrec Int
p = \case
    Haskell{} -> String -> ShowS
showString String
"Haskell"
    Haskell a
(:$) -> String -> ShowS
showString String
"($)"
    Haskell (a -> a -> a)
(:.) :@ Haskell a
f :@ Haskell a
g ->
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9)
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
Function.$ Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
9 Haskell a
f
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. String -> ShowS
showString String
" . "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
9 Haskell a
g
    Haskell a
(:.) -> String -> ShowS
showString String
"(.)"
    Haskell (a -> a -> a)
Cons :@ Haskell a
x :@ Haskell a
xs ->
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10)
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
Function.$ Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Haskell a
x
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. String -> ShowS
showString String
" : "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Haskell a
xs
    Haskell a
Cons -> String -> ShowS
showString String
"cons"
    Haskell a
Const -> String -> ShowS
showString String
"const"
    Eq Haskell a
x ->
      Bool -> ShowS -> ShowS
showParen Bool
True
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
Function.$ String -> ShowS
showString String
"== "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Haskell a
x
    Haskell a
Flip -> String -> ShowS
showString String
"flip"
    Haskell a
Id -> String -> ShowS
showString String
"id"
    Haskell a
Unit -> String -> ShowS
showString String
"()"
    (:@) Haskell (a -> a)
f Haskell a
x ->
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10)
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
Function.$ Int -> Haskell (a -> a) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Haskell (a -> a)
f
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. String -> ShowS
showString String
" "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Int -> Haskell a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 Haskell a
x
instance Trans Haskell Value where
  trans :: forall a. Haskell a -> Value a
trans = ValueCode a -> Value a
forall a. ValueCode a -> Value a
value (ValueCode a -> Value a)
-> (Haskell a -> ValueCode a) -> Haskell a -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Haskell a -> ValueCode a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans
instance Trans Haskell TH.CodeQ where
  trans :: forall a. Haskell a -> CodeQ a
trans = ValueCode a -> CodeQ a
forall a. ValueCode a -> CodeQ a
code (ValueCode a -> CodeQ a)
-> (Haskell a -> ValueCode a) -> Haskell a -> CodeQ a
forall b c a. (b -> c) -> (a -> b) -> a -> c
Function.. Haskell a -> ValueCode a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans
instance Trans Haskell ValueCode where
  trans :: forall a. Haskell a -> ValueCode a
trans = \case
    Haskell ValueCode a
x -> ValueCode a
x
    Haskell a
(:.) -> ValueCode a
forall (repr :: * -> *) b c a.
Haskellable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.)
    Haskell a
(:$) -> ValueCode a
forall (repr :: * -> *) a b.
Haskellable repr =>
repr ((a -> b) -> a -> b)
($)
    (:@) Haskell (a -> a)
f Haskell a
x -> ValueCode (a -> a) -> ValueCode a -> ValueCode a
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
(.@) (Haskell (a -> a) -> ValueCode (a -> a)
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans Haskell (a -> a)
f) (Haskell a -> ValueCode a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans Haskell a
x)
    Haskell a
Cons -> ValueCode a
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
cons
    Haskell a
Const -> ValueCode a
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
const
    Eq Haskell a
x -> ValueCode a -> ValueCode (a -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
eq (Haskell a -> ValueCode a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans Haskell a
x)
    Haskell a
Flip -> ValueCode a
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip
    Haskell a
Id -> ValueCode a
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
id
    Haskell a
Unit -> ValueCode a
forall (repr :: * -> *). Haskellable repr => repr ()
unit
instance Trans ValueCode Haskell where
  trans :: forall a. ValueCode a -> Haskell a
trans = ValueCode a -> Haskell a
forall a. ValueCode a -> Haskell a
Haskell
type instance Output Haskell = ValueCode

instance Haskellable Haskell where
  . :: forall b c a. Haskell ((b -> c) -> (a -> b) -> a -> c)
(.)     = Haskell ((b -> c) -> (a -> b) -> a -> c)
forall b c a. Haskell ((b -> c) -> (a -> b) -> a -> c)
(:.)
  $ :: forall a b. Haskell ((a -> b) -> a -> b)
($)     = Haskell ((a -> b) -> a -> b)
forall a b. Haskell ((a -> b) -> a -> b)
(:$)
  -- Small optimizations, mainly to reduce dump sizes.
  Haskell (a -> b)
Id .@ :: forall a b. Haskell (a -> b) -> Haskell a -> Haskell b
.@ Haskell a
x = Haskell a
Haskell b
x
  (Haskell (a -> a -> b)
Const :@ Haskell a
x) .@ Haskell a
_y = Haskell b
Haskell a
x
  ((Haskell (a -> a -> a -> b)
Flip :@ Haskell a
Const) :@ Haskell a
_x) .@ Haskell a
y = Haskell a
Haskell b
y
  --
  Haskell (a -> b)
f .@ Haskell a
x  = Haskell (a -> b)
f Haskell (a -> b) -> Haskell a -> Haskell b
forall a b. Haskell (a -> b) -> Haskell a -> Haskell b
:@ Haskell a
x
  cons :: forall a. Haskell (a -> [a] -> [a])
cons    = Haskell (a -> [a] -> [a])
forall a. Haskell (a -> [a] -> [a])
Cons
  const :: forall a b. Haskell (a -> b -> a)
const   = Haskell (a -> b -> a)
forall a b. Haskell (a -> b -> a)
Const
  eq :: forall a. Eq a => Haskell a -> Haskell (a -> Bool)
eq      = Haskell a -> Haskell (a -> Bool)
forall a. Eq a => Haskell a -> Haskell (a -> Bool)
Eq
  flip :: forall a b c. Haskell ((a -> b -> c) -> b -> a -> c)
flip    = Haskell ((a -> b -> c) -> b -> a -> c)
forall a b c. Haskell ((a -> b -> c) -> b -> a -> c)
Flip
  id :: forall a. Haskell (a -> a)
id      = Haskell (a -> a)
forall a. Haskell (a -> a)
Id
  unit :: Haskell ()
unit    = Haskell ()
Unit
  bool :: Bool -> Haskell Bool
bool Bool
b  = ValueCode Bool -> Haskell Bool
forall a. ValueCode a -> Haskell a
Haskell (Bool -> ValueCode Bool
forall (repr :: * -> *). Haskellable repr => Bool -> repr Bool
bool Bool
b)
  char :: forall tok. Lift tok => tok -> Haskell tok
char tok
c  = ValueCode tok -> Haskell tok
forall a. ValueCode a -> Haskell a
Haskell (tok -> ValueCode tok
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
char tok
c)
  nil :: forall a. Haskell [a]
nil     = ValueCode [a] -> Haskell [a]
forall a. ValueCode a -> Haskell a
Haskell ValueCode [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
nil
  left :: forall l r. Haskell (l -> Either l r)
left    = ValueCode (l -> Either l r) -> Haskell (l -> Either l r)
forall a. ValueCode a -> Haskell a
Haskell ValueCode (l -> Either l r)
forall (repr :: * -> *) l r.
Haskellable repr =>
repr (l -> Either l r)
left
  right :: forall r l. Haskell (r -> Either l r)
right   = ValueCode (r -> Either l r) -> Haskell (r -> Either l r)
forall a. ValueCode a -> Haskell a
Haskell ValueCode (r -> Either l r)
forall (repr :: * -> *) r l.
Haskellable repr =>
repr (r -> Either l r)
right
  nothing :: forall a. Haskell (Maybe a)
nothing = ValueCode (Maybe a) -> Haskell (Maybe a)
forall a. ValueCode a -> Haskell a
Haskell ValueCode (Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (Maybe a)
nothing
  just :: forall a. Haskell (a -> Maybe a)
just    = ValueCode (a -> Maybe a) -> Haskell (a -> Maybe a)
forall a. ValueCode a -> Haskell a
Haskell ValueCode (a -> Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> Maybe a)
just
instance Haskellable ValueCode where
  . :: forall b c a. ValueCode ((b -> c) -> (a -> b) -> a -> c)
(.)      = Value ((b -> c) -> (a -> b) -> a -> c)
-> CodeQ ((b -> c) -> (a -> b) -> a -> c)
-> ValueCode ((b -> c) -> (a -> b) -> a -> c)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) b c a.
Haskellable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.) CodeQ ((b -> c) -> (a -> b) -> a -> c)
forall (repr :: * -> *) b c a.
Haskellable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(.)
  $ :: forall a b. ValueCode ((a -> b) -> a -> b)
($)      = Value ((a -> b) -> a -> b)
-> CodeQ ((a -> b) -> a -> b) -> ValueCode ((a -> b) -> a -> b)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr ((a -> b) -> a -> b)
($) CodeQ ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr ((a -> b) -> a -> b)
($)
  .@ :: forall a b. ValueCode (a -> b) -> ValueCode a -> ValueCode b
(.@) ValueCode (a -> b)
f ValueCode a
x = Value b -> CodeQ b -> ValueCode b
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode (Value (a -> b) -> Value a -> Value b
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
(.@) (ValueCode (a -> b) -> Value (a -> b)
forall a. ValueCode a -> Value a
value ValueCode (a -> b)
f) (ValueCode a -> Value a
forall a. ValueCode a -> Value a
value ValueCode a
x)) (Code Q (a -> b) -> Code Q a -> CodeQ b
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
(.@) (ValueCode (a -> b) -> Code Q (a -> b)
forall a. ValueCode a -> CodeQ a
code ValueCode (a -> b)
f) (ValueCode a -> Code Q a
forall a. ValueCode a -> CodeQ a
code ValueCode a
x))
  bool :: Bool -> ValueCode Bool
bool Bool
b   = Value Bool -> CodeQ Bool -> ValueCode Bool
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode (Bool -> Value Bool
forall (repr :: * -> *). Haskellable repr => Bool -> repr Bool
bool Bool
b) (Bool -> CodeQ Bool
forall (repr :: * -> *). Haskellable repr => Bool -> repr Bool
bool Bool
b)
  char :: forall tok. Lift tok => tok -> ValueCode tok
char tok
c   = Value tok -> CodeQ tok -> ValueCode tok
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode (tok -> Value tok
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
char tok
c) (tok -> CodeQ tok
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
char tok
c)
  cons :: forall a. ValueCode (a -> [a] -> [a])
cons     = Value (a -> [a] -> [a])
-> CodeQ (a -> [a] -> [a]) -> ValueCode (a -> [a] -> [a])
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
cons CodeQ (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
cons
  const :: forall a b. ValueCode (a -> b -> a)
const    = Value (a -> b -> a)
-> CodeQ (a -> b -> a) -> ValueCode (a -> b -> a)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (a -> b -> a)
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
const CodeQ (a -> b -> a)
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
const
  eq :: forall a. Eq a => ValueCode a -> ValueCode (a -> Bool)
eq ValueCode a
x     = Value (a -> Bool) -> CodeQ (a -> Bool) -> ValueCode (a -> Bool)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode (Value a -> Value (a -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
eq (ValueCode a -> Value a
forall a. ValueCode a -> Value a
value ValueCode a
x)) (Code Q a -> CodeQ (a -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
eq (ValueCode a -> Code Q a
forall a. ValueCode a -> CodeQ a
code ValueCode a
x))
  flip :: forall a b c. ValueCode ((a -> b -> c) -> b -> a -> c)
flip     = Value ((a -> b -> c) -> b -> a -> c)
-> CodeQ ((a -> b -> c) -> b -> a -> c)
-> ValueCode ((a -> b -> c) -> b -> a -> c)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip CodeQ ((a -> b -> c) -> b -> a -> c)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
flip
  id :: forall a. ValueCode (a -> a)
id       = Value (a -> a) -> CodeQ (a -> a) -> ValueCode (a -> a)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (a -> a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
id CodeQ (a -> a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
id
  nil :: forall a. ValueCode [a]
nil      = Value [a] -> CodeQ [a] -> ValueCode [a]
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
nil CodeQ [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
nil
  unit :: ValueCode ()
unit     = Value () -> CodeQ () -> ValueCode ()
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value ()
forall (repr :: * -> *). Haskellable repr => repr ()
unit CodeQ ()
forall (repr :: * -> *). Haskellable repr => repr ()
unit
  left :: forall l r. ValueCode (l -> Either l r)
left     = Value (l -> Either l r)
-> CodeQ (l -> Either l r) -> ValueCode (l -> Either l r)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (l -> Either l r)
forall (repr :: * -> *) l r.
Haskellable repr =>
repr (l -> Either l r)
left CodeQ (l -> Either l r)
forall (repr :: * -> *) l r.
Haskellable repr =>
repr (l -> Either l r)
left
  right :: forall r l. ValueCode (r -> Either l r)
right    = Value (r -> Either l r)
-> CodeQ (r -> Either l r) -> ValueCode (r -> Either l r)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (r -> Either l r)
forall (repr :: * -> *) r l.
Haskellable repr =>
repr (r -> Either l r)
right CodeQ (r -> Either l r)
forall (repr :: * -> *) r l.
Haskellable repr =>
repr (r -> Either l r)
right
  nothing :: forall a. ValueCode (Maybe a)
nothing  = Value (Maybe a) -> CodeQ (Maybe a) -> ValueCode (Maybe a)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (Maybe a)
nothing CodeQ (Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (Maybe a)
nothing
  just :: forall a. ValueCode (a -> Maybe a)
just     = Value (a -> Maybe a)
-> CodeQ (a -> Maybe a) -> ValueCode (a -> Maybe a)
forall a. Value a -> CodeQ a -> ValueCode a
ValueCode Value (a -> Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> Maybe a)
just CodeQ (a -> Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> Maybe a)
just
instance Haskellable Value where
  . :: forall b c a. Value ((b -> c) -> (a -> b) -> a -> c)
(.)      = ((b -> c) -> (a -> b) -> a -> c)
-> Value ((b -> c) -> (a -> b) -> a -> c)
forall a. a -> Value a
Value (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(Function..)
  $ :: forall a b. Value ((a -> b) -> a -> b)
($)      = ((a -> b) -> a -> b) -> Value ((a -> b) -> a -> b)
forall a. a -> Value a
Value (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
(Function.$)
  .@ :: forall a b. Value (a -> b) -> Value a -> Value b
(.@) Value (a -> b)
f Value a
x = b -> Value b
forall a. a -> Value a
Value (Value (a -> b) -> a -> b
forall a. Value a -> a
unValue Value (a -> b)
f (Value a -> a
forall a. Value a -> a
unValue Value a
x))
  bool :: Bool -> Value Bool
bool     = Bool -> Value Bool
forall a. a -> Value a
Value
  char :: forall tok. Lift tok => tok -> Value tok
char     = tok -> Value tok
forall a. a -> Value a
Value
  cons :: forall a. Value (a -> [a] -> [a])
cons     = (a -> [a] -> [a]) -> Value (a -> [a] -> [a])
forall a. a -> Value a
Value (:)
  const :: forall a b. Value (a -> b -> a)
const    = (a -> b -> a) -> Value (a -> b -> a)
forall a. a -> Value a
Value a -> b -> a
forall a b. a -> b -> a
Function.const
  eq :: forall a. Eq a => Value a -> Value (a -> Bool)
eq Value a
x     = (a -> Bool) -> Value (a -> Bool)
forall a. a -> Value a
Value (Value a -> a
forall a. Value a -> a
unValue Value a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Eq.==)
  flip :: forall a b c. Value ((a -> b -> c) -> b -> a -> c)
flip     = ((a -> b -> c) -> b -> a -> c)
-> Value ((a -> b -> c) -> b -> a -> c)
forall a. a -> Value a
Value (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
Function.flip
  id :: forall a. Value (a -> a)
id       = (a -> a) -> Value (a -> a)
forall a. a -> Value a
Value a -> a
forall a. a -> a
Function.id
  nil :: forall a. Value [a]
nil      = [a] -> Value [a]
forall a. a -> Value a
Value []
  unit :: Value ()
unit     = () -> Value ()
forall a. a -> Value a
Value ()
  left :: forall l r. Value (l -> Either l r)
left     = (l -> Either l r) -> Value (l -> Either l r)
forall a. a -> Value a
Value l -> Either l r
forall a b. a -> Either a b
Left
  right :: forall r l. Value (r -> Either l r)
right    = (r -> Either l r) -> Value (r -> Either l r)
forall a. a -> Value a
Value r -> Either l r
forall a b. b -> Either a b
Right
  nothing :: forall a. Value (Maybe a)
nothing  = Maybe a -> Value (Maybe a)
forall a. a -> Value a
Value Maybe a
forall a. Maybe a
Nothing
  just :: forall a. Value (a -> Maybe a)
just     = (a -> Maybe a) -> Value (a -> Maybe a)
forall a. a -> Value a
Value a -> Maybe a
forall a. a -> Maybe a
Just
instance Haskellable TH.CodeQ where
  . :: forall b c a. CodeQ ((b -> c) -> (a -> b) -> a -> c)
(.)      = [|| (Function..) ||]
  $ :: forall a b. CodeQ ((a -> b) -> a -> b)
($)      = [|| (Function.$) ||]
  .@ :: forall a b. CodeQ (a -> b) -> CodeQ a -> CodeQ b
(.@) CodeQ (a -> b)
f CodeQ a
x = [|| $$f $$x ||]
  bool :: Bool -> CodeQ Bool
bool Bool
b   = [|| b ||]
  char :: forall tok. Lift tok => tok -> CodeQ tok
char tok
c   = [|| c ||]
  cons :: forall a. CodeQ (a -> [a] -> [a])
cons     = [|| (:) ||]
  const :: forall a b. CodeQ (a -> b -> a)
const    = [|| Function.const ||]
  eq :: forall a. Eq a => CodeQ a -> CodeQ (a -> Bool)
eq CodeQ a
x     = [|| ($$x Eq.==) ||]
  flip :: forall a b c. CodeQ ((a -> b -> c) -> b -> a -> c)
flip     = [|| \f x y -> f y x ||]
  id :: forall a. CodeQ (a -> a)
id       = [|| \x -> x ||]
  nil :: forall a. CodeQ [a]
nil      = [|| [] ||]
  unit :: CodeQ ()
unit     = [|| () ||]
  left :: forall l r. CodeQ (l -> Either l r)
left     = [|| Left ||]
  right :: forall r l. CodeQ (r -> Either l r)
right    = [|| Right ||]
  nothing :: forall a. CodeQ (Maybe a)
nothing  = [|| Nothing ||]
  just :: forall a. CodeQ (a -> Maybe a)
just     = [|| Just ||]