algebraic-classes (empty) → 0
raw patch · 6 files changed
+271/−0 lines, 6 filesdep +basedep +sybdep +template-haskellsetup-changed
Dependencies added: base, syb, template-haskell
Files
- Data/Algebra.hs +54/−0
- Data/Algebra/Internal.hs +32/−0
- Data/Algebra/TH.hs +116/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- algebraic-classes.cabal +37/−0
+ Data/Algebra.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE + TypeFamilies + , ConstraintKinds+ , MultiParamTypeClasses+ , FlexibleInstances+ , UndecidableInstances+ , TemplateHaskell+ , DeriveFunctor+ #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algebra+-- Copyright : (c) Sjoerd Visscher 2013+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : sjoerd@w3future.com+-- Stability : experimental+-- Portability : non-portable+-----------------------------------------------------------------------------+module Data.Algebra + ( -- * Classes+ AlgebraSignature(..)+ , Algebra(..)+ -- * Template Haskell functions+ , deriveInstance+ , deriveSignature+ -- * Example signature+ , MonoidSignature(..)+ ) where++import Data.Algebra.Internal+import Data.Algebra.TH++import Control.Arrow ((&&&))+import Data.Monoid+++instance Algebra f () where+ algebra = const () ++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 fab a = evaluate (fmap ($ a) fab)+ +-- | 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
+ Data/Algebra/Internal.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE + TypeFamilies + , ConstraintKinds+ , MultiParamTypeClasses+ #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algebra.Internal+-- Copyright : (c) Sjoerd Visscher 2013+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : sjoerd@w3future.com+-- Stability : experimental+-- Portability : non-portable+-----------------------------------------------------------------------------+module Data.Algebra.Internal where++import GHC.Exts (Constraint)++class Functor f => AlgebraSignature f where+ -- | The class for which @f@ is the signature.+ type Class f :: * -> Constraint+ -- | Translate the operations of the signature to method calls of the class.+ evaluate :: Class f b => f b -> b++class Algebra f a where+ -- | An algebra @f a -> a@ corresponds to an instance of @a@ of the class @Class f@.+ -- In some cases, for example for tuple types, you can give an algebra generically for every signature:+ --+ -- > instance (Class f m, Class f n) => Algebra f (m, n) where+ -- > algebra fmn = (evaluate (fmap fst fmn), evaluate (fmap snd fmn))+ algebra :: AlgebraSignature f => f a -> a
+ Data/Algebra/TH.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE TemplateHaskell #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algebra.TH+-- Copyright : (c) Sjoerd Visscher 2013+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : sjoerd@w3future.com+-- Stability : experimental+-- Portability : non-portable+-----------------------------------------------------------------------------+module Data.Algebra.TH + ( deriveInstance+ , deriveSignature+ -- * Possibly useful internals+ , SignatureTH(..)+ , OperationTH(..)+ , getSignatureInfo+ , buildSignatureDataType+ , signatureInstance+ ) where++import Data.Algebra.Internal++import Control.Applicative+import Language.Haskell.TH+import Data.Generics++data SignatureTH = SignatureTH + { signatureName :: Name+ , typeVarName :: Name+ , operations :: [OperationTH]+ }++data OperationTH = OperationTH+ { functionName :: Name+ , operationName :: Name+ , arguments :: [Type]+ }++getSignatureInfo :: Name -> Q SignatureTH+getSignatureInfo name = do+ ClassI (ClassD _ _ _ _ decs) _ <- reify name+ let tv = mkName "a"+ SignatureTH + <$> changeName (++ "Signature") name + <*> pure tv + <*> sequence + [ OperationTH nm+ <$> changeName ("Op_" ++) nm + <*> (everywhere (mkT (rename tv' tv)) <$> buildOperation tv' tp)+ | SigD nm (ForallT [PlainTV tv'] _ tp) <- decs + ]++-- | Derive a signature for an algebraic class.+-- For exaple:+--+-- > deriveSignature ''Num+--+-- `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.+--+-- This will do nothing if there is already a signature for the class in scope.+deriveSignature :: Name -> Q [Dec]+deriveSignature className = do+ mName <- lookupTypeName (nameBase className ++ "Signature")+ s <- getSignatureInfo className+ return $ if mName == Nothing then buildSignatureDataType s ++ signatureInstance className s else []++-- | Derive an instance for an algebraic class.+-- For example: +--+-- > deriveInstance [t| (Num m, Num n) => Num (m, n) |]+--+-- To be able to derive an instance for @a@ of class @c@, we need an instance of @`Algebra` f a@,+-- where @f@ is the signature of @c@.+--+-- `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+ s <- getSignatureInfo className+ let+ impl = + [ FunD fName [Clause (map VarP args) (NormalB (AppE (VarE 'algebra) (foldl (\e arg -> AppE e (VarE arg)) (ConE opName) args))) []] + | OperationTH fName opName ts <- operations s, let args = mkArgList (length ts) ]+ (++ [InstanceD ctx (AppT (ConT className) typeName) impl]) <$> deriveSignature className++buildSignatureDataType :: SignatureTH -> [Dec]+buildSignatureDataType s =+ let cons = [ NormalC nm (map ((,) NotStrict) ts) | OperationTH _ nm ts <- operations s ]+ in [DataD [] (signatureName s) [PlainTV (typeVarName s)] cons [''Functor, ''Show]]++signatureInstance :: Name -> SignatureTH -> [Dec]+signatureInstance nm s = [inst]+ where+ typeInst = TySynInstD ''Class [ConT (signatureName s)] (ConT nm)+ clauses = + [ Clause [ConP opName (map VarP args)] (NormalB (foldl (\e arg -> AppE e (VarE arg)) (VarE fName) args)) []+ | OperationTH fName opName ts <- operations s, let args = mkArgList (length ts) ]+ inst = InstanceD [] (AppT (ConT ''AlgebraSignature) (ConT (signatureName s))) [typeInst, FunD 'evaluate clauses]++buildOperation :: Name -> Type -> Q [Type]+buildOperation nm (VarT nm') = if nm == nm' then return [] else fail "This class is not an algebra."+buildOperation nm (AppT (AppT ArrowT h) t) = (h :) <$> buildOperation nm t+buildOperation _ t = fail $ "Don't know how to handle: " ++ show t++changeName :: (String -> String) -> Name -> Q Name+changeName f = return . mkName . f . nameBase++mkArgList :: Int -> [Name]+mkArgList n = [ mkName $ "a" ++ show i | i <- [1 .. n] ]++rename :: Name -> Name -> Type -> Type+rename a b (VarT c) | a == c = VarT b+rename _ _ t = t
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Sjoerd Visscher++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sjoerd Visscher nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ algebraic-classes.cabal view
@@ -0,0 +1,37 @@+name: algebraic-classes+version: 0+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@.+ .+ F-algebras are functions @f a -> a@, where the functor @f@ is called the signature, and the type @a@ the carrier.+ .+ This package relates these 2 concepts, and can create conversions between the two using Template Haskell.+ More specifically, it can generate:+ .+ * signatures from algebraic classes+ .+ * instances of algebraic classes from F-algebras.+ .+ This is useful because type classes are more commonly used in Haskell than F-algebras, but F-algebras are+ easier to work with, because they are just functions.+homepage: https://github.com/sjoerdvisscher/algebraic-classes+license: BSD3+license-file: LICENSE+author: Sjoerd Visscher+maintainer: sjoerd@w3future.com+category: Data+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules:+ Data.Algebra+ Data.Algebra.TH+ Data.Algebra.Internal+ + build-depends:+ base == 4.6.*+ , syb == 0.4.*+ , template-haskell == 2.8.0.*+