# 01-Value.purs

``````module Free.ExpressionBased.VariantF.Value
(
-- data type and VariantF injection stuff
ValueF, Value, value

-- eval stuff
, valueAlgebra, example_value, eval

-- The "glue" that makes this work (Expression stuff)
-- Normally, this file would not have these declarations because
-- a library would provide it and we'd import it here.
, Expression(..), fold, run
) where

import Prelude
import Effect (Effect)
import Effect.Console (log)
import Data.Functor.Variant (VariantF, inj, on, case_)
import Type.Row (type (+))
import Type.Proxy (Proxy(..))

-- Expression, fold, and algebra-unspecific run
-- (These would be imported from the libraries that provide them)
newtype Expression f = In (f (Expression f))

fold :: forall f a. Functor f => (f a -> a) -> Expression f -> a
fold f (In t) = f (map (fold f) t)

-- see `eval` below
run :: forall f a b output
. Functor f
-- |     case_        | # |    algebra       |
=> ((VariantF () a -> b) -> f output -> output)
-> Expression f
-> output
run algebra expression = fold (case_ # algebra) expression

-- data stuff
data ValueF :: Type -> Type
data ValueF e = ValueF Int

derive instance Functor ValueF

-- VariantF stuff
type Value :: Row (Type -> Type) -> Row (Type -> Type)
type Value r = (value :: ValueF | r)

valueSymbol :: Proxy "value"
valueSymbol = Proxy

value :: forall r. Int -> Expression (VariantF (Value + r))
value i = In \$ inj valueSymbol (ValueF i)

example_value :: forall r. Expression (VariantF (Value + r))
example_value = value 5

-- eval stuff
valueAlgebra :: forall r
. (VariantF r Int -> Int)
-> (VariantF (Value + r) Int -> Int)
valueAlgebra = on valueSymbol \(ValueF x) -> x

-- This function is not necessary.
--
-- It simply makes `run` above seem more sensible by giving you a
-- more familiar name and by defining the output type to be `Int`
eval :: forall f a b
. Functor f
=> ((VariantF () a -> b) -> f Int -> Int)
-> Expression f
-> Int
eval = run

-- examples
main :: Effect Unit
main = log \$ show \$ eval valueAlgebra example_value
``````