-- |
-- Module      : Conjure.Cases
-- 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 module defines the 'Cases' typeclass
-- that allows listing cases of a type
-- encoded as 'Expr's
--
-- You are probably better off importing "Conjure".
{-# Language DeriveDataTypeable, StandaloneDeriving #-} -- for GHC < 7.10
module Conjure.Cases
  ( Cases (..)
  , Fxpr
  , sumFxpr
  , factFxpr
  , nullFxpr
  , isZeroFxpr
  )
where

import Conjure.Utils
import Data.Express
import Data.Express.Express
import Data.Express.Fixtures
import Data.Dynamic
import Data.Typeable (Typeable)

type Fxpr  =  (Expr, Cxpr)
type Cxpr  =  [([Expr],Expr)]

sumFxpr :: Fxpr
sumFxpr :: Fxpr
sumFxpr  =  String -> ([Int] -> Int) -> Expr
forall a. Typeable a => String -> a -> Expr
var String
"sum" ([Int] -> Int
forall a. HasCallStack => a
undefined :: [Int] -> Int) Expr -> [([Expr], Expr)] -> Fxpr
forall a b. a -> b -> (a, b)
=-
  [ [Expr
nil]           [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=-  Expr
zero
  , [(Expr
xx Expr -> Expr -> Expr
-:- Expr
xxs)]  [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=-  Expr
xx Expr -> Expr -> Expr
-+- (String -> ([Int] -> Int) -> Expr
forall a. Typeable a => String -> a -> Expr
var String
"recurse" ([Int] -> Int
forall a. HasCallStack => a
undefined :: [Int] -> Int) Expr -> Expr -> Expr
:$ Expr
xxs)
  ]
  where
  =- :: a -> b -> (a, b)
(=-) = (,)
  infixr 0 =-

factFxpr :: Fxpr
factFxpr :: Fxpr
factFxpr  =  String -> Fxpr
forall a. HasCallStack => String -> a
error String
"TODO: write me"

nullFxpr :: Fxpr
nullFxpr :: Fxpr
nullFxpr  =  String -> Expr
forall a. HasCallStack => String -> a
error String
"TODO" Expr -> [([Expr], Expr)] -> Fxpr
forall a b. a -> b -> (a, b)
=-
  [ [Expr
nil]          [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=- Expr
false
  , [(Expr
xx Expr -> Expr -> Expr
-:- Expr
xxs)] [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=- Expr
false
  ]
  where
  =- :: a -> b -> (a, b)
(=-) = (,)
  infixr 0 =-

isZeroFxpr :: Fxpr
isZeroFxpr :: Fxpr
isZeroFxpr  =  String -> Expr
forall a. HasCallStack => String -> a
error String
"TODO" Expr -> [([Expr], Expr)] -> Fxpr
forall a b. a -> b -> (a, b)
=-
  [ [Expr
zero]  [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=- Expr
true
  , [Expr -> Expr
forall a. a
inc Expr
xx] [Expr] -> Expr -> ([Expr], Expr)
forall a b. a -> b -> (a, b)
=- Expr
false
  ]
  where
  inc :: a
inc = a
forall a. HasCallStack => a
undefined -- TODO: define me
  =- :: a -> b -> (a, b)
(=-) = (,)
  infixr 0 =-


-- | Evaluates an 'Expr' using the given 'Fxpr' as definition
--   when a recursive call is found.
fxprToDynamic :: Int -> Fxpr -> Expr -> Maybe Dynamic
fxprToDynamic :: Int -> Fxpr -> Expr -> Maybe Dynamic
fxprToDynamic  =  Int -> Fxpr -> Expr -> Maybe Dynamic
forall a. HasCallStack => a
undefined


class Express a => Cases a where
  cases :: a -> [Expr]

instance Cases () where
  cases :: () -> [Expr]
cases ()
_  =  [() -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val ()]

instance Cases Bool where
  cases :: Bool -> [Expr]
cases Bool
_  =  [Bool -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val Bool
False, Bool -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val Bool
True]

instance Cases Int where
  cases :: Int -> [Expr]
cases Int
x  =  [Int -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val (Int
0 Int -> Int -> Int
forall a. a -> a -> a
-: Int
x), Int -> Expr
forall a. Typeable a => a -> Expr
hole Int
x]

instance Cases Integer where
  cases :: Integer -> [Expr]
cases Integer
x  =  [Integer -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val (Integer
0 Integer -> Integer -> Integer
forall a. a -> a -> a
-: Integer
x), Integer -> Expr
forall a. Typeable a => a -> Expr
hole Integer
x]

instance Cases Char where
  cases :: Char -> [Expr]
cases Char
_  =  []

instance Express a => Cases [a] where
  cases :: [a] -> [Expr]
cases [a]
xs  =  [ [a] -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val ([] [a] -> [a] -> [a]
forall a. a -> a -> a
-: [a]
xs)
               , String -> (a -> [a] -> [a]) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
":" ((:) (a -> [a] -> [a]) -> [a] -> a -> [a] -> [a]
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: [a]
xs) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ [a] -> Expr
forall a. Typeable a => a -> Expr
hole [a]
xs
               ]
    where
    x :: a
x  =  [a] -> a
forall a. [a] -> a
head [a]
xs

instance (Express a, Express b) => Cases (a,b) where
  cases :: (a, b) -> [Expr]
cases (a, b)
xy  =  [String -> (a -> b -> (a, b)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"," ((,) (a -> b -> (a, b)) -> (a, b) -> a -> b -> (a, b)
forall a b c. (a -> b -> c) -> c -> a -> b -> c
->>: (a, b)
xy) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Typeable a => a -> Expr
hole b
y]
    where
    (a
x,b
y) = (a
forall a. HasCallStack => a
undefined,b
forall a. HasCallStack => a
undefined) (a, b) -> (a, b) -> (a, b)
forall a. a -> a -> a
-: (a, b)
xy

instance (Express a, Express b, Express c) => Cases (a,b,c) where
  cases :: (a, b, c) -> [Expr]
cases (a, b, c)
xyz  =  [String -> (a -> b -> c -> (a, b, c)) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
",," ((,,) (a -> b -> c -> (a, b, c)) -> (a, b, c) -> a -> b -> c -> (a, b, c)
forall a b c d. (a -> b -> c -> d) -> d -> a -> b -> c -> d
->>>: (a, b, c)
xyz) Expr -> Expr -> Expr
:$ a -> Expr
forall a. Typeable a => a -> Expr
hole a
x Expr -> Expr -> Expr
:$ b -> Expr
forall a. Typeable a => a -> Expr
hole b
y Expr -> Expr -> Expr
:$ c -> Expr
forall a. Typeable a => a -> Expr
hole c
z]
    where
    (a
x,b
y,c
z) = (a
forall a. HasCallStack => a
undefined,b
forall a. HasCallStack => a
undefined,c
forall a. HasCallStack => a
undefined) (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. a -> a -> a
-: (a, b, c)
xyz

instance Express a => Cases (Maybe a) where
  cases :: Maybe a -> [Expr]
cases Maybe a
mx  =  [ String -> Maybe a -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Nothing" (Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a -> Maybe a
forall a. a -> a -> a
-: Maybe a
mx)
               , String -> (a -> Maybe a) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Just" (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> a -> Maybe a
forall a b. (a -> b) -> b -> a -> b
->: Maybe a
mx) Expr -> Expr -> Expr
:$ Maybe a -> Expr
forall a. Typeable a => a -> Expr
hole Maybe a
x
               ]
    where
    x :: Maybe a
x  =  a -> Maybe a
forall a. a -> Maybe a
Just a
forall a. HasCallStack => a
undefined Maybe a -> Maybe a -> Maybe a
forall a. a -> a -> a
-: Maybe a
mx


instance (Express a, Express b) => Cases (Either a b) where
  cases :: Either a b -> [Expr]
cases Either a b
exy  =  [ String -> (a -> Either a b) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Left" (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Either a b -> a -> Either a b
forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ Either a b -> Expr
forall a. Typeable a => a -> Expr
hole Either a b
x
                , String -> (b -> Either a b) -> Expr
forall a. Typeable a => String -> a -> Expr
value String
"Right" (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Either a b -> b -> Either a b
forall a b. (a -> b) -> b -> a -> b
->: Either a b
exy) Expr -> Expr -> Expr
:$ Either a b -> Expr
forall a. Typeable a => a -> Expr
hole Either a b
y
                ]
    where
    x :: Either a b
x  =  a -> Either a b
forall a b. a -> Either a b
Left a
forall a. HasCallStack => a
undefined Either a b -> Either a b -> Either a b
forall a. a -> a -> a
-: Either a b
exy
    y :: Either a b
y  =  b -> Either a b
forall a b. b -> Either a b
Right b
forall a. HasCallStack => a
undefined Either a b -> Either a b -> Either a b
forall a. a -> a -> a
-: Either a b
exy