Haskell Code by HsColour

{-# OPTIONS_GHC -fth -cpp #-}

-- | @EnumCyclic@ defines the @Enum@ class, using the same
-- modifications as our @Enum@ derivation, but additionally @succ@
-- and @pred@ treat the data type as cyclic, wrapping between the
-- first and last constructors.

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 (b-1)
 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")))) [])])])]]