algebraic-classes 0.2.1 → 0.3

raw patch · 4 files changed

+51/−35 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Algebra.hs +4/−19
• Data/Algebra/Internal.hs +3/−5
• Data/Algebra/TH.hs +43/−10
• algebraic-classes.cabal +1/−1

@@ -18,28 +18,13 @@ -- Portability :  non-portable ----------------------------------------------------------------------------- module Data.Algebra -  ( -- * Classes-    AlgebraSignature(..)+  ( deriveInstance+  , deriveInstanceWith+    -- * Classes   , Algebra(..)   , algebraA-    -- * Template Haskell functions-  , deriveInstance-  , deriveSignature-    -- * Example signature-  , MonoidSignature(..)+  , AlgebraSignature(..)   ) where  import Data.Algebra.Internal import Data.Algebra.TH--import Data.Monoid--  --- | The `Monoid` signature has this `AlgebraSignature` instance:------ > instance AlgebraSignature MonoidSignature where--- >   type Class MonoidSignature = Monoid--- >   evaluate Op_mempty = mempty--- >   evaluate (Op_mappend a b) = mappend a b--- >   evaluate (Op_mconcat ms) = mconcat ms-deriveSignature ''Monoid

@@ -23,6 +23,7 @@  import GHC.Conc (STM) import Data.Monoid+import Control.Arrow ((&&&))  class Traversable f => AlgebraSignature f where   -- | The class for which @f@ is the signature.@@ -44,11 +45,8 @@  instance Algebra f () where   algebra = const () ---- There are 2 possible instances for tuples:--- instance (Class f m, Class f n) => Algebra f (m, n) where---   algebra = evaluate . fmap fst &&& evaluate . fmap snd--- instance (Monoid a, Class f b) => Algebra f (a, b) where algebra = algebraA+instance (Class f m, Class f n) => Algebra f (m, n) where+  algebra = evaluate . fmap fst &&& evaluate . fmap snd  instance Class f b => Algebra f (a -> b) where algebra = algebraA instance Class f b => Algebra f (IO b) where algebra = algebraA

@@ -11,6 +11,7 @@ ----------------------------------------------------------------------------- module Data.Algebra.TH    ( deriveInstance+  , deriveInstanceWith   , deriveSignature   -- * Possibly useful internals   , SignatureTH(..)@@ -58,12 +59,22 @@       ]  -- | Derive a signature for an algebraic class.---   For exaple:+--   For example: ----- > deriveSignature ''Num+-- > deriveSignature ''Monoid --+--   The above would generate the following:+--+-- > data MonoidSignature a = Op_mempty | Op_mappend a a | Op_mconcat [a]+-- >   deriving (Functor, Foldable, Traversable, Show, Eq, Ord)+-- > instance AlgebraSignature MonoidSignature where+-- >   type Class MonoidSignature = Monoid+-- >   evaluate Op_mempty = mempty+-- >   evaluate (Op_mappend a b) = mappend a b+-- >   evaluate (Op_mconcat ms) = mconcat ms  +-- --   `deriveSignature` creates the signature data type and an instance for it of the---   `AlgebraSignature` class. @DeriveFunctor@ is used the generate the `Functor` instance of the signature.+--   `AlgebraSignature` class. @DeriveTraversable@ is used the generate the `Traversable` instance of the signature. -- --   This will do nothing if there is already a signature for the class in scope. deriveSignature :: Name -> Q [Dec]@@ -82,19 +93,41 @@ -- --   `deriveInstance` will generate a signature for the class if there is no signature in scope. deriveInstance :: Q Type -> Q [Dec]-deriveInstance typ = do-  (ForallT _ ctx (AppT (ConT className) typeName)) <- typ+deriveInstance typ = deriveInstanceWith typ $ return []++-- | Derive an instance for an algebraic class with a given partial implementation.+--   For example:+--+-- > deriveInstanceWith [t| Num n => Num (Integer -> n) |] +-- >   [d|+-- >     fromInteger x y = fromInteger (x + y)+-- >   |]+deriveInstanceWith :: Q Type -> Q [Dec] -> Q [Dec]+deriveInstanceWith qtyp dec = do+  typ <- qtyp+  case typ of+    ForallT _ ctx (AppT (ConT className) typeName) -> deriveInstanceWith' ctx className typeName dec+    AppT (ConT className) typeName -> deriveInstanceWith' [] className typeName dec++deriveInstanceWith' :: Cxt -> Name -> Type -> Q [Dec] -> Q [Dec]+deriveInstanceWith' ctx className typeName dec = do+  given <- dec   s <- getSignatureInfo className-  let+  let +    givenLU = +      [ (nameBase nm, \nm' -> FunD nm' cs) | FunD nm cs <- given ] ++ +      [ (nameBase nm, \nm' -> ValD (VarP nm') b ds) | ValD (VarP nm) b ds <- given]     impl = -      [ FunD fName [Clause (map VarP args) (NormalB (AppE (VarE 'algebra) (foldl (\e arg -> AppE e (VarE arg)) (ConE opName) args))) []] -      | OperationTH fName opName ar _ <- operations s, let args = mkArgList ar ]+      [ maybe +          (FunD fName [Clause (map VarP args) (NormalB (AppE (VarE 'algebra) (foldl (\e arg -> AppE e (VarE arg)) (ConE opName) args))) []]) +          ($ fName) mgiven+      | OperationTH fName opName ar _ <- operations s, let mgiven = lookup (nameBase fName) givenLU, let args = mkArgList ar ]      (++ [InstanceD ctx (AppT (ConT className) typeName) impl]) <$> deriveSignature className  buildSignatureDataType :: SignatureTH -> [Dec] buildSignatureDataType s =   let cons = [ con | OperationTH _ _ _ con <- operations s ]-  in [DataD [] (signatureName s) [PlainTV (typeVarName s)] cons [''Functor, ''Foldable, ''Traversable, ''Show]]+  in [DataD [] (signatureName s) [PlainTV (typeVarName s)] cons [''Functor, ''Foldable, ''Traversable, ''Show, ''Eq, ''Ord]]  signatureInstance :: Name -> SignatureTH -> [Dec] signatureInstance nm s = [inst]@@ -108,7 +141,7 @@ buildOperation :: Name -> Type -> Maybe (Int, Name -> Con) buildOperation nm (VarT nm') = if nm == nm' then Just (0, \opName -> NormalC opName []) else Nothing buildOperation nm (AppT (AppT ArrowT h) t) = ((+1) *** fmap (prependC (NotStrict, h))) <$> buildOperation nm t-buildOperation _ t = Nothing+buildOperation _ _ = Nothing  changeName :: (String -> String) -> Name -> Name changeName f = mkName . f . nameBase

@@ -1,5 +1,5 @@ name:                algebraic-classes-version:             0.2.1+version:             0.3 synopsis:            Conversions between algebraic classes and F-algebras. description:         Algebraic classes are type classes where all the methods return a value of the same type, which is also the class parameter.                      Examples from @base@ are @Num@ and @Monoid@.