algebraic-classes 0.9.4 → 0.10

raw patch · 5 files changed

+65/−35 lines, 5 filesdep ~basedep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG +14/−0
• Data/Algebra/Internal.hs +3/−3
• Data/Algebra/TH.hs +34/−24
• algebraic-classes.cabal +11/−5
• examples/Fractional.hs +3/−3

@@ -1,3 +1,17 @@+0.9.4 -> 0.10+- Update for GHC 9.6 through 9.14++0.9.2 -> 0.9.4+- Update for GHC 8.8+  - Updated to base-4.13.0.0+  - Updated to template-haskell-2.15.0.0+- Add Ap instance++0.9.1 -> 0.9.2+- Update for GHC 8.6+  - Updated to base-4.12.0.0+  - Updated to template-haskell-2.14.0.0+ 0.9 -> 0.9.1 - Update for GHC 8.4   - Updated to base-4.11.0.0

@@ -17,7 +17,7 @@ ----------------------------------------------------------------------------- module Data.Algebra.Internal where -import GHC.Exts (Constraint)+import Data.Kind (Constraint, Type) import Control.Applicative (Const) import Data.Monoid (Ap) @@ -25,11 +25,11 @@ import Control.Arrow ((&&&))  -- | The signature datatype for the class @c@.-type family Signature (c :: * -> Constraint) :: * -> *+type family Signature (c :: Type -> Constraint) :: Type -> Type  class Traversable f => AlgebraSignature f where   -- | The class for which @f@ is the signature.-  type Class f :: * -> Constraint+  type Class f :: Type -> Constraint   -- | Translate the operations of the signature to method calls of the class.   evaluate :: Class f b => f b -> b 

@@ -1,4 +1,7 @@-{-# LANGUAGE TemplateHaskell, TupleSections #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Algebra.TH@@ -62,28 +65,26 @@ getSignatureInfo :: Name -> Q SignatureTH getSignatureInfo name = do   ClassI (ClassD ctx _ [tyvar] _ decs) _ <- reify name-  let tv = tvName tyvar+  let tv = tyVarName tyvar   let sigName = changeName (++ "Signature") name-  ops <- for decs $ \sig ->-    case sig of-      SigD nm (ForallT [tv'] _ tp) -> mkOp nm tp tv (tvName tv')-      SigD nm tp -> mkOp nm tp tv tv-      _ -> return Nothing-  scs <- for ctx $ \ty ->-    case ty of-      (AppT (ConT scName) (VarT tv')) | tv == tv' -> do-        s <- getSignatureInfo scName-        case s of-          SignatureTH _ _ [] [] -> return Nothing-          _ -> return $ Just $ SuperclassTH scName (changeName (addScPrefix name) scName) s-      _ -> return Nothing+  ops <- for decs $ \case+    SigD nm (ForallT [tv'] _ tp) -> mkOp nm tp tv (tyVarName tv')+    SigD nm tp -> mkOp nm tp tv tv+    _ -> return Nothing+  scs <- for ctx $ \case+    (AppT (ConT scName) (VarT tv')) | tv == tv' -> do+      s <- getSignatureInfo scName+      case s of+        SignatureTH _ _ [] [] -> return Nothing+        _ -> return $ Just $ SuperclassTH scName (changeName (addScPrefix name) scName) s+    _ -> return Nothing   return $ SignatureTH sigName tv (catMaybes ops) (catMaybes scs)   where     mkOp nm tp tv tv' = do       dec <- reify nm       fty <- fromMaybe defaultFixity <$> reifyFixity nm       case dec of-        ClassOpI _ _ _ ->+        ClassOpI{} ->           return $ case buildOperation tv' tp of             Just (ar, mkCon) ->               let opName = changeName addPrefix nm@@ -172,6 +173,7 @@       deriveSuperclassInstances' ctx className typeName     AppT (ConT className) typeName ->       deriveSuperclassInstances' [] className typeName+    s -> error $ "Unsupported type: " <> show s  deriveSuperclassInstances' :: Cxt -> Name -> Type -> Q [Dec] deriveSuperclassInstances' ctx className typeName = do@@ -196,6 +198,7 @@       deriveInstanceWith'' addSignature ctx className typeName id dec     AppT (ConT className) typeName ->       deriveInstanceWith'' addSignature [] className typeName id dec+    s -> error $ "Unsupported type: " <> show s  deriveInstanceWith'' :: Bool -> Cxt -> Name -> Type -> (Exp -> Exp) -> Q [Dec] -> Q [Dec] deriveInstanceWith'' addSignature ctx className typeName wrap dec = do@@ -214,9 +217,15 @@   (++ [InstanceD Nothing ctx (AppT (ConT className) typeName) impl]) <$>     if addSignature then deriveSignature className else return [] +#if MIN_VERSION_template_haskell(2,21,0)+#else+bndrReq :: ()+bndrReq = ()+#endif+ buildSignatureDataType :: SignatureTH -> [Dec] buildSignatureDataType s =-  [DataD [] (signatureName s) [PlainTV (typeVarName s)] Nothing+  [DataD [] (signatureName s) [PlainTV (typeVarName s) bndrReq] Nothing     ((constructor <$> operations s) ++ (buildSuperclassCon (typeVarName s) <$> superclasses s))     [DerivClause Nothing (map ConT [''Functor, ''Foldable, ''Traversable, ''Eq, ''Ord])]] @@ -227,17 +236,17 @@     sigTFInst = TySynInstD (TySynEqn Nothing (AppT (ConT ''Signature) (ConT nm)) signature)     typeInst = TySynInstD (TySynEqn Nothing (AppT (ConT ''Class) signature) (ConT nm))     asClauses =-      [ Clause [ConP opName (map VarP args)] (NormalB (foldl (\e arg -> AppE e (VarE arg)) (VarE fName) args)) []+      [ Clause [ConP opName [] (map VarP args)] (NormalB (foldl (\e arg -> AppE e (VarE arg)) (VarE fName) args)) []       | OperationTH fName opName ar _ _ <- operations s, let args = mkArgList ar ]     asScClauses =-      [ Clause [ConP conName [(VarP v)]] (NormalB $ AppE (VarE 'evaluate) (VarE v)) []+      [ Clause [ConP conName [] [(VarP v)]] (NormalB $ AppE (VarE 'evaluate) (VarE v)) []       | SuperclassTH _ conName _ <- superclasses s, let v = mkName "v"]     asInst = InstanceD Nothing [] (AppT (ConT ''AlgebraSignature) signature) [typeInst, FunD 'evaluate (asClauses ++ asScClauses)]     showsPrecClauses =-      [ Clause [VarP d, ConP opName (map VarP args)] (NormalB $ createShowsPrec d (nameBase fName) prec args) []+      [ Clause [VarP d, ConP opName [] (map VarP args)] (NormalB $ createShowsPrec d (nameBase fName) prec args) []       | OperationTH fName opName ar _ (Fixity prec _) <- operations s, let args = mkArgList ar, let d = mkName "d" ]     showsPrecScClauses =-      [ Clause [VarP d, ConP conName [(VarP v)]] (NormalB $ AppE (AppE (VarE 'showsPrec) (VarE d)) (VarE v)) []+      [ Clause [VarP d, ConP conName [] [(VarP v)]] (NormalB $ AppE (AppE (VarE 'showsPrec) (VarE d)) (VarE v)) []       | SuperclassTH _ conName _ <- superclasses s, let d = mkName "d", let v = mkName "v"]     createShowsPrec d name prec [u,v] | isOperator name =       InfixE (Just (AppE (VarE 'showParen) (InfixE (Just (VarE d)) (VarE '(>)) (Just (LitE (IntegerL prec')))))) (VarE '($))@@ -292,10 +301,11 @@  prependC :: Type -> Con -> Con prependC st (NormalC nm sts) = NormalC nm ((bangDef, st):sts)+prependC _ s = error $ "Unsupported type: " <> show s  bangDef :: Bang bangDef = Bang NoSourceUnpackedness NoSourceStrictness -tvName :: TyVarBndr -> Name-tvName (PlainTV nm) = nm-tvName (KindedTV nm _) = nm+tyVarName :: TyVarBndr s -> Name+tyVarName (PlainTV n _) = n+tyVarName (KindedTV n _ _) = n

@@ -1,5 +1,5 @@ name:                algebraic-classes-version:             0.9.4+version:             0.10 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@.@@ -23,10 +23,13 @@ maintainer:          sjoerd@w3future.com category:            Data, Generics, Math build-type:          Simple-cabal-version:       >=1.8+cabal-version:       2.0+tested-with:         GHC==9.6.7, GHC==9.8.4, GHC==9.10.3, GHC==9.12.2, GHC==9.14.1  extra-source-files:   examples/*.hs++extra-doc-files:   CHANGELOG  library@@ -36,10 +39,13 @@     Data.Algebra.Internal    build-depends:-      base >= 4.10 && < 4.14+    base >= 4.18 && < 4.23     , syb == 0.7.*-    , template-haskell >= 2.12 && < 2.16+    , template-haskell >= 2.20 && < 2.25 +  default-language:+    Haskell2010+ source-repository head   type:     git-  location: git://github.com/sjoerdvisscher/algebraic-classes.git+  location: https://github.com/sjoerdvisscher/algebraic-classes

@@ -2,12 +2,12 @@ {-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveTraversable, RankNTypes #-}  import Data.Algebra-import Data.Algebra.TH+-- import Data.Algebra.TH import Data.Ratio --- deriveInstance [t| forall m n. (Num m, Num n) => Num (m, n) |]+deriveInstance [t| forall m n. (Num m, Num n) => Num (m, n) |] deriveInstance [t| forall m n. (Fractional m, Fractional n) => Fractional (m, n) |]-deriveSuperclassInstances [t| forall m n. (Fractional m, Fractional n) => Fractional (m, n) |]+-- deriveSuperclassInstances [t| forall m n. (Fractional m, Fractional n) => Fractional (m, n) |]  test :: (Ratio Int, Ratio Int) test = (5, 3) / (3, 2) + (1, 4)