module Data.Derive.EnumCyclic(makeEnumCyclic) where
import Language.Haskell.TH.All
#ifdef GUESS
import Data.DeriveGuess
example = (,) "EnumCyclic" [d|
instance Enum (DataName a) where
toEnum 0 = CtorZero{}
toEnum 1 = CtorOne {}
toEnum 2 = CtorTwo {}
toEnum 3 = CtorTwo'{}
toEnum n = error $ "toEnum " ++ show n ++ ", not defined for " ++ "DataName"
fromEnum (CtorZero{}) = 0
fromEnum (CtorOne {}) = 1
fromEnum (CtorTwo {}) = 2
fromEnum (CtorTwo'{}) = 3
succ a = if b == 3 then toEnum 0 else toEnum (b+1)
where b = fromEnum a
pred a = if b == 0 then toEnum 3 else toEnum (b1)
where b = fromEnum a
|]
#endif
makeEnumCyclic :: Derivation
makeEnumCyclic = derivation enumCyclic' "EnumCyclic"
enumCyclic' dat = [instance_context [] "Enum" dat [(FunD (mkName "toEnum") ((
map (\(ctorInd,ctor) -> (Clause [(LitP (IntegerL ctorInd))] (NormalB ((flip
RecConE []) (mkName ("" ++ ctorName ctor)))) [])) (id (zip [0..] (dataCtors
dat))))++[(Clause [(VarP (mkName "n"))] (NormalB (applyWith (VarE (mkName
"$")) [(VarE (mkName "error")),(applyWith (VarE (mkName "++")) [(LitE (
StringL "toEnum ")),(applyWith (VarE (mkName "++")) [(AppE (VarE (mkName
"show")) (VarE (mkName "n"))),(applyWith (VarE (mkName "++")) [(LitE (
StringL ", not defined for ")),(LitE (StringL (dataName dat)))])])])])) [])
]++[])),(FunD (mkName "fromEnum") ((map (\(ctorInd,ctor) -> (Clause [((flip
RecP []) (mkName ("" ++ ctorName ctor)))] (NormalB (LitE (IntegerL ctorInd)
)) [])) (id (zip [0..] (dataCtors dat))))++[])),(FunD (mkName "succ") [(
Clause [(VarP (mkName "a"))] (NormalB (CondE (applyWith (VarE (mkName "==")
) [(VarE (mkName "b")),(LitE (IntegerL (toInteger (length (dataCtors dat)))
))]) (AppE (VarE (mkName "toEnum")) (LitE (IntegerL 0))) (AppE (VarE (
mkName "toEnum")) (applyWith (VarE (mkName "+")) [(VarE (mkName "b")),(LitE
(IntegerL 1))])))) [(ValD (VarP (mkName "b")) (NormalB (AppE (VarE (mkName
"fromEnum")) (VarE (mkName "a")))) [])])]),(FunD (mkName "pred") [(Clause [
(VarP (mkName "a"))] (NormalB (CondE (applyWith (VarE (mkName "==")) [(VarE
(mkName "b")),(LitE (IntegerL 0))]) (AppE (VarE (mkName "toEnum")) (LitE (
IntegerL (toInteger (length (dataCtors dat)))))) (AppE (VarE (mkName
"toEnum")) (applyWith (VarE (mkName "-")) [(VarE (mkName "b")),(LitE (
IntegerL 1))])))) [(ValD (VarP (mkName "b")) (NormalB (AppE (VarE (mkName
"fromEnum")) (VarE (mkName "a")))) [])])])]]