-----------------------------------------------------------------------------
-- |
-- Module : Data.Default
-- Copyright : (c) 2010 University of Minho
-- License : BSD3
--
-- Maintainer : hpacheco@di.uminho.pt
-- Stability : experimental
-- Portability : non-portable
--
-- Pointless Rewrite:
-- automatic transformation system for point-free programs
--
-- Type-safe representation of types and point-free expressions at the value level, including
-- representation of recursive types as fixpoints of functors.
--
-----------------------------------------------------------------------------
module Data.Default where
import Data.Type
import Data.Spine
import Generics.Pointless.Functors
type Generator = forall a. Type a -> a
type GeneratorF = forall f a. Fctr f -> Type a -> Rep f a
-- | Default generator for representable types
defvalue :: Generator
defvalue Int = 0
defvalue Bool = False
defvalue Char = ' '
defvalue (Prod a b) = (defvalue a,defvalue b)
defvalue (Either a b) = Left $ defvalue a
defvalue (List a) = []
defvalue a@(Data _ f) = inn $ defvalueF f a
defvalue a@(NewData _ f) = Inn $ defvalueF f a
defvalue a = error $ "no default generator for " ++ show a
-- | Default generator for representable functor types
-- important to deal with recursive occurences to avoid infinite values
defvalueF :: GeneratorF
defvalueF I a = defvalue a
defvalueF L a = []
defvalueF (K c) a = defvalue c
defvalueF (f :*!: g) a = (defvalueF f a,defvalueF g a)
defvalueF (f :+!: g) a = if (countId f <= countId g) then Left (defvalueF f a) else Right (defvalueF g a)
defvalueF (I :@!: g) a = defvalueF g a
defvalueF (K c :@!: g) a = defvalue c
defvalueF (L :@!: g) a = []
defvalueF ((f :*!: g) :@!: h) a = defvalueF ((f :@!: h) :*!: (g :@!: h)) a
defvalueF ((f :+!: g) :@!: h) a = defvalueF ((f :@!: h) :+!: (g :@!: h)) a
defvalueF ((f :@!: g) :@!: h) a = defvalueF (f :@!: (g :@!: h)) a
-- | Counts the number of recursive invocations in a functor
countId :: Fctr f -> Int
countId I = 1
countId (K c) = 0
countId L = 0
countId (f :*!: g) = countId f + countId g
countId (f :+!: g) = min (countId f) (countId g)
countId (I :@!: g) = countId g
countId (K c :@!: g) = 0
countId (L :@!: g) = 0 -- as long as we return the empty list, there is no problem with recursive invocations
countId ((f :*!: g) :@!: h) = countId ((f :@!: h) :*!: (g :@!: h))
countId ((f :+!: g) :@!: h) = countId ((f :@!: h) :+!: (g :@!: h))
countId ((f :@!: g) :@!: h) = countId (f :@!: (g :@!: h))