{-#LANGUAGE DeriveDataTypeable, TemplateHaskell #-}-- | Everything you need to construct an enumeration for an algebraic type.-- Just define each constructor using pure for nullary constructors and -- unary and funcurry for positive arity constructors, then combine the -- constructors with consts. Example:-- -- @-- instance Enumerable a => Enumerable [a] where-- enumerate = consts [unary (funcurry (:)), pure []]-- @---- There's also a handy Template Haskell function for automatic derivation.moduleTest.Feat.Class(Enumerable(..),-- ** Building instancesConstructor,nullary,unary,funcurry,consts,-- ** Accessing the enumerator of an instanceoptimised,-- *** Free pairsFreePair(..),-- ** Deriving instances with template HaskellderiveEnumerable,deriveEnumerable',ConstructorDeriv,dAll,dExcluding,dExcept-- autoCon,-- autoCons)where-- testing-featimportTest.Feat.EnumerateimportTest.Feat.Internals.Tag(Tag(Class))importTest.Feat.Internals.DeriveimportTest.Feat.Internals.Newtypes-- baseimportData.TypeableimportData.Monoid-- template-haskellimportLanguage.Haskell.THimportLanguage.Haskell.TH.Syntax-- base - only for instancesimportData.WordimportData.IntimportData.BitsimportData.Ratio-- | A class of functionally enumerable typesclassTypeablea=>Enumerableawhere-- | This is the interface for defining an instance. Memoisation needs to -- be ensured e.g. using 'mempay' but sharing is handled automatically by -- the default implementation of 'shared'.enumerate::Enumeratea-- | Version of enumerate that ensures it is shared between-- all accessing functions. Should always be used when -- combining enumerations.-- Should typically be left to default behaviour.shared::Enumerateashared=tagShareClassenumerate-- | An optimised version of enumerate. Used by all-- library functions that access enumerated values (but not -- by combining functions). Library functions should ensure that -- @optimised@ is not reevaluated.optimised::Enumerablea=>Enumerateaoptimised=optimiseshared-- | A free pair constructor. The cost of constructing a free pair-- is equal to the sum of the costs of its components. newtypeFreePairab=Free{free::(a,b)}deriving(Show,Typeable)-- | Uncurry a function (typically a constructor) to a function on free pairs.funcurry::(a->b->c)->FreePairab->cfuncurryf=uncurryf.freeinstance(Enumerablea,Enumerableb)=>Enumerable(FreePairab)whereenumerate=mem$curryFree<$>shared<*>sharedtypeConstructor=Enumerate-- | For nullary constructors such as @True@ and @[]@.nullary::a->Constructoranullary=pure-- | For any non-nullary constructor. Apply 'funcurry' until the type of-- the result is unary (i.e. n-1 times where n is the number of fields -- of the constructor).unary::Enumerablea=>(a->b)->Constructorbunaryf=f<$>shared-- | Produces the enumeration of a type given the enumerators for each of its-- constructors. The result of 'unary' should typically not be used -- directly in an instance even if it only has one constructor. So you -- should apply consts even in that case. consts::[Constructora]->Enumerateaconstsxs=mempay$mconcatxs---------------------------------------------------------------------- Automatic derivation-- | Derive an instance of Enumberable with Template Haskell.deriveEnumerable::Name->Q[Dec]deriveEnumerable=deriveEnumerable'.dAll-- fmap return . instanceFor ''Enumerable [enumDef]typeConstructorDeriv=(Name,[(Name,ExpQ)])dAll::Name->ConstructorDerivdAlln=(n,[])dExcluding::Name->ConstructorDeriv->ConstructorDerivdExcludingn(t,nrs)=(t,(n,[|mempty|]):nrs)dExcept::Name->ExpQ->ConstructorDeriv->ConstructorDerivdExceptne(t,nrs)=(t,(n,e):nrs)-- | Derive an instance of Enumberable with Template Haskell, with -- rules for some specific constructorsderiveEnumerable'::ConstructorDeriv->Q[Dec]deriveEnumerable'(n,cse)=fmapreturn$instanceFor''Enumerable[enumDef]nwhereenumDef::[(Name,[Type])]->QDecenumDefcons=dosanityCheckfmapmk_freqs_binding[|consts$ex|]whereex=listE$mapconeconsconexs@(n,_)=maybe(cone'xs)id$lookupncsecone'(n,[])=[|nullary$(conEn)|]cone'(n,_:vs)=[|unary$(foldrappE(conEn)(map(const[|funcurry|])vs))|]mk_freqs_binding::Exp->Decmk_freqs_bindinge=ValD(VarP'enumerate)(NormalBe)[]sanityCheck=casefilter(`notElem`mapfstcons)(mapfstcse)of[]->return()xs->error$"Invalid constructors for "++shown++": "++showxs-- do-- (_,ns,_) <- extractData n-- if all (map snd nse) (`elem` ns) -- then return () -- else error $ "Invalid constructors for "++show n++": "++-- show (filter (`notElem` ns) (map fst nse)) ----------------------------------------------------------------------- Instances(letit=mapM(instanceFor''Enumerable[enumDef])[''[],''Bool,''(),''(,),''(,,),''(,,,),''(,,,,),''(,,,,,),''(,,,,,,)-- This is as far as typeable goes...,''Either,''Maybe,''Ordering]-- Circumventing the stage restrictions by means of code repetition.enumDef::[(Name,[Type])]->QDecenumDefcons=fmapmk_freqs_binding[|consts$ex|]whereex=listE$mapconeconscone(n,[])=[|pure$(conEn)|]cone(n,_:vs)=[|unary$(foldrappE(conEn)(map(const[|funcurry|])vs))|]mk_freqs_binding::Exp->Decmk_freqs_bindinge=ValD(VarP'enumerate)(NormalBe)[]init)-- This instance is quite important. It needs to be exponential for -- the other instances to work.instanceInfinitea=>Enumerable(Nata)whereenumerate=lete=Enumerate{card=crd,select=sel,optimal=returne}inewherecrdp|p<=0=0|p==1=1|otherwise=2^(p-2)sel::Numa=>Part->Index->Natasel10=Nat0selpi=Nat$2^(p-2)+fromIntegeri-- This instance is used by the Int* instances and needs to be exponential as -- well.instanceEnumerableIntegerwhereenumerate=unaryfwheref(Free(b,Nati))=ifbthen-i-1elseiinstance(Infinitea,Enumerablea)=>Enumerable(NonZeroa)whereenumerate=unary(\a->NonZero$ifa>=0thena+1elsea)-- An exported version would have to use $tag instead of Classword::(Bitsa,Integrala)=>Enumerateaword=ewheree=cutOff(bitSize'e+1)$unary(fromInteger.nat)int::(Bitsa,Integrala)=>Enumerateaint=ewheree=cutOff(bitSize'e+1)$unaryfromIntegercutOff::Int->Enumeratea->EnumerateacutOffne=e{card=\p->ifp>nthen0elsecardep,optimal=fmap(cutOffn)$optimale}bitSize'::Bitsa=>fa->IntbitSize'f=hlpundefinedfwherehlp::Bitsa=>a->fa->Inthlpa_=bitSizeainstanceEnumerableWordwhereenumerate=wordinstanceEnumerableWord8whereenumerate=wordinstanceEnumerableWord16whereenumerate=wordinstanceEnumerableWord32whereenumerate=wordinstanceEnumerableWord64whereenumerate=wordinstanceEnumerableIntwhereenumerate=intinstanceEnumerableInt8whereenumerate=intinstanceEnumerableInt16whereenumerate=intinstanceEnumerableInt32whereenumerate=intinstanceEnumerableInt64whereenumerate=int-- | Not injectiveinstanceEnumerableDoublewhereenumerate=unary(funcurryencodeFloat)-- | Not injectiveinstanceEnumerableFloatwhereenumerate=unary(funcurryencodeFloat)-- This should be fixed with a bijective funtion.-- | Not injectiveinstance(Infinitea,Enumerablea)=>Enumerable(Ratioa)whereenumerate=unary$funcurry$\ab->a%nonZerob-- | Contains only ASCII charactersinstanceEnumerableCharwhereenumerate=cutOff8$unary(toEnum.fromIntegral::Word->Char)