Skip to content

Instantly share code, notes, and snippets.

@dredozubov
Created September 4, 2019 16:02
Show Gist options
  • Save dredozubov/5f9ddac7aad329139a247e0cd9492d04 to your computer and use it in GitHub Desktop.
Save dredozubov/5f9ddac7aad329139a247e0cd9492d04 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module ALaCarte where
(∘) = (.)
data Expr f = In (f (Expr f))
data (f :+: g) e = Inl (f e) | Inr (g e)
deriving (Functor, Show, Eq)
class sub :≺: sup where
inj :: sub a -> sup a
instance (Functor sub) => sub :≺: sub where
inj = id
instance {-# OVERLAPPING #-} (Functor f, Functor g) => f :≺: (f :+: g) where
inj = Inl
instance {-# OVERLAPPABLE #-}
(Functor f, Functor g, Functor h, f :≺: g) => f :≺: (h :+: g) where
inj = Inr ∘ inj
foldExpr :: Functor f => (f a -> a) -> Expr f -> a
foldExpr f (In e) = f (foldExpr f <$> e)
eval :: forall f. (Functor f, Eval f) => Expr f -> Int
eval = foldExpr evalAlgebra
class Eval f where
evalAlgebra :: f Int -> Int
instance (Eval f, Eval g) => Eval (f :+: g) where
evalAlgebra (Inl x) = evalAlgebra x
evalAlgebra (Inr y) = evalAlgebra y
-- constructors
data Val e = Val Int deriving (Functor, Show, Eq)
instance Eval Val where
evalAlgebra (Val i) = i
data Add e = Add e e deriving (Functor, Show, Eq)
instance Eval Add where
evalAlgebra (Add x y) = x + y
-- smart constructors
inject :: (g :≺: f) => g (Expr f) -> Expr f
inject = In ∘ inj
val :: (Val :≺: f) => Int -> Expr f
val = inject ∘ Val
(⊕) :: (Add :≺: f) => Expr f -> Expr f -> Expr f
x ⊕ y = inject (Add x y)
infixl 7 ⊕
main = do
let x ::Expr (Add :+: Val) = val 30000 ⊕ val 1330 ⊕ val 7
print $ eval x
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment