{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE
TypeFamilies
, TypeOperators
, DeriveFunctor
, DeriveFoldable
, ConstraintKinds
, TemplateHaskell
, DeriveTraversable
, FlexibleInstances
, UndecidableInstances
, QuantifiedConstraints
, MultiParamTypeClasses
#-}
module Data.Functor.Free (
Free(..)
, deriveInstances
, unit
, rightAdjunct
, counit
, leftAdjunct
, transform
, unfold
, convert
, convertClosed
, Extract(..)
, Duplicate(..)
, Coproduct
, coproduct
, inL
, inR
, InitialObject
, initial
, ShowHelper(..)
) where
import Data.Function
import Data.Void
import Data.Functor.Free.Internal
unfold :: (b -> Coproduct c b a) -> b -> Free c a
unfold f = fix $ \go -> transform (\k -> either (rightAdjunct k . go) k) . f
convert :: (c (f a), Applicative f) => Free c a -> f a
convert = rightAdjunct pure
convertClosed :: c r => Free c Void -> r
convertClosed = rightAdjunct absurd
type Coproduct c m n = Free c (Either m n)
coproduct :: c r => (m -> r) -> (n -> r) -> Coproduct c m n -> r
coproduct m n = rightAdjunct (either m n)
inL :: m -> Coproduct c m n
inL = unit . Left
inR :: n -> Coproduct c m n
inR = unit . Right
type InitialObject c = Free c Void
initial :: c r => InitialObject c -> r
initial = rightAdjunct absurd
deriveInstances ''Num
deriveInstances ''Fractional
deriveInstances ''Floating
deriveInstances ''Semigroup
deriveInstances ''Monoid