free-functors 1.2.1 → 1.3

raw patch · 7 files changed

+149/−20 lines, 7 filesdep ~basedep ~derive-lifted-instancesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, derive-lifted-instances, template-haskell, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• examples/Automaton.hs +6/−6
• examples/Laws.hs +127/−0
• free-functors.cabal +11/−9
• src/Data/Functor/Cofree/Internal.hs +1/−1
• src/Data/Functor/Free.hs +1/−2
• src/Data/Functor/HFree.hs +0/−2

@@ -1,4 +1,7 @@ CHANGELOG+1.2 -> 1.3+  - Add support for GHC 9.6 through 9.14+  - Update to derive-lifted-instances v0.3  1.1.2 -> 1.2   - Add support for GHC 9.0, drop GHC 8.8

@@ -6,13 +6,13 @@   #-} module Automaton where -import Data.Functor.Cofree-import Data.Functor.Cofree.Internal-import Data.DeriveLiftedInstances+import Data.Functor.Cofree ( Cofree(..) )+import Data.Functor.Cofree.Internal ( cofreeDeriv )+import Data.DeriveLiftedInstances ( deriveInstance ) -import Control.Comonad-import Data.Functor.Identity-import Data.Functor.Compose+import Control.Comonad ( Comonad(extract) )+import Data.Functor.Identity ( Identity )+import Data.Functor.Compose ( Compose(..) )   class Action i s where

@@ -0,0 +1,127 @@+{-# LANGUAGE+    TypeFamilies+  , GADTs+  , LambdaCase+  , RankNTypes+  , BlockArguments+  , KindSignatures+  , ScopedTypeVariables+  , ConstraintKinds+  , FlexibleInstances+  , FlexibleContexts+  , DeriveGeneric+  , DeriveAnyClass+  , TypeApplications+  , AllowAmbiguousTypes+  , StandaloneDeriving+  , UndecidableInstances+  #-}+module Laws where++import GHC.Generics (Generic)+import Data.Functor.Free ( Free )+import qualified Data.Functor.Free as Free ( rightAdjunct, unit )+import Data.Functor.HFree ( HFree )+import qualified Data.Functor.HFree as HFree ( rightAdjunct, unit )+import Data.Kind (Type, Constraint)+import Test.QuickCheck ( quickCheck, Arbitrary(..), CoArbitrary, Gen )++import Data.Monoid (Sum)+import Control.Applicative (ZipList)++data EQ a = a :=: a deriving (Eq, Show)+infix 4 :=:++class Laws (c :: Type -> Constraint) where+  type Var c :: Type+  laws :: [EQ (Free c (Var c))]++data VAR = X | Y | Z deriving (Eq, Show, Generic, CoArbitrary)++instance Show a => Show (VAR -> a) where+  show f = unlines $ map show [(X, f X), (Y, f Y), (Z, f Z)]++x, y, z :: Free c VAR+x = Free.unit X+y = Free.unit Y+z = Free.unit Z++instance Laws Semigroup where+  type Var Semigroup = VAR+  laws = [x <> (y <> z) :=: (x <> y) <> z]++instance Laws Monoid where+  type Var Monoid = VAR+  laws =+    [ x <> mempty :=: x+    , mempty <> x :=: x+    ]++props :: forall c a. (Laws c, c a, Eq a) => (Var c -> a) -> Bool+props f = and $ (\(l :=: r) -> Free.rightAdjunct f l == Free.rightAdjunct f r) <$> laws @c++checkLaws :: forall c a. (Laws c, c a, CoArbitrary (Var c), Arbitrary a, Eq a, Show (Var c -> a)) => IO ()+checkLaws = quickCheck (props @c @a)++run :: IO ()+run = checkLaws @Semigroup @(Sum Double)+++data EQ1 f a = f a :==: f a+deriving instance Eq (f a) => Eq (EQ1 f a)+deriving instance Show (f a) => Show (EQ1 f a)+infix 4 :==:++class Laws1 (c :: (Type -> Type) -> Constraint) where+  type Var1 c :: (Type -> Type)+  type Param c :: Type+  laws1 :: [EQ1 (HFree c (Var1 c)) (Param c)]++data VAR1 a where+  U :: VAR1 (Int -> Int)+  V :: VAR1 (Int -> Int)+  W :: VAR1 Int+deriving instance Eq (VAR1 a)+deriving instance Show (VAR1 a)++u :: HFree c VAR1 (Int -> Int)+u = HFree.unit U+v :: HFree c VAR1 (Int -> Int)+v = HFree.unit V+w :: HFree c VAR1 Int+w = HFree.unit W++instance Laws1 Applicative where+  type Var1 Applicative = VAR1+  type Param Applicative = Int+  laws1 =+    [ (pure id <*> w) :==: w+    , (pure (.) <*> u <*> v <*> w) :==: (u <*> (v <*> w))+    , (pure (+ 1) <*> pure 2) :==: pure 3+    , (u <*> pure 1) :==: (pure ($ 1) <*> u)+    ]++newtype Nat c f = Nat (forall a. Var1 c a -> f a)+instance (Functor f, Arbitrary (f Int), Arbitrary (f (Int -> Int))) => Arbitrary (Nat Applicative f) where+  arbitrary = do+    u' <- arbitrary :: Gen (f (Int -> Int))+    v' <- arbitrary :: Gen (f (Int -> Int))+    w' <- arbitrary :: Gen (f Int)+    pure $ Nat \case+      U -> u'+      V -> v'+      W -> w'+instance (Show (f Int), Show (f (Int -> Int))) => Show (Nat Applicative f) where+  show (Nat f) = unlines [show (U, f U), show (V, f V), show (W, f W)]++instance Show (Int -> Int) where+  show f = ".." ++ (init . tail . show) [f (-2), f (-1), f 0, f 1, f 2] ++ ".."++props1 :: forall c f. (Laws1 c, c f, Eq (f (Param c))) => Nat c f -> Bool+props1 (Nat f) = and $ (\(l :==: r) -> HFree.rightAdjunct f l == HFree.rightAdjunct f r) <$> laws1 @c++checkLaws1 :: forall c f. (Laws1 c, c f, Eq (f (Param c)), Arbitrary (Nat c f), Functor f, Show (Nat c f)) => IO ()+checkLaws1 = quickCheck (props1 @c @f)++run1 :: IO ()+run1 = checkLaws1 @Applicative @[]

@@ -1,5 +1,5 @@ name:                free-functors-version:             1.2.1+version:             1.3 synopsis:            Free functors, adjoint to functors that forget class constraints. description:         A free functor is a left adjoint to a forgetful functor. It used to be the case                      that the only category that was easy to work with in Haskell was Hask itself, so@@ -21,15 +21,17 @@ bug-reports:         https://github.com/sjoerdvisscher/free-functors/issues  build-type:          Simple-cabal-version:       >= 1.10-tested-with:         GHC==9.0.0.20200925, GHC==8.10.2, GHC==8.8.4+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-  HS-Source-Dirs:+  hs-source-dirs:     src    exposed-modules:@@ -46,11 +48,11 @@     Haskell2010    build-depends:-    base >= 4.13 && < 4.16,-    template-haskell >= 2.15 && < 2.18,-    transformers == 0.5.*,+    base >= 4.18 && < 4.23,+    template-haskell >= 2.20 && < 2.25,+    transformers >= 0.5 && < 0.7,     comonad == 5.*,-    derive-lifted-instances >= 0.2.2 && < 0.3,+    derive-lifted-instances == 0.3.*,     contravariant == 1.5.*,     bifunctors == 5.*,     profunctors == 5.*@@ -58,4 +60,4 @@  source-repository head   type:     git-  location: git://github.com/sjoerdvisscher/free-functors.git+  location: https://github.com/sjoerdvisscher/free-functors

@@ -40,7 +40,7 @@   cst = \e -> [| const $e $kExp |], -- Suppress "Defined but not used: ‘k’" warning   res = \e -> [| $(pure (ConE cofree)) $kExp $e |],   eff = \e -> [| $(pure (ConE cofree)) $kExp <$> $e |],-  inp = fmap (\vp -> ConP cofree [kPat, vp])+  inp = fmap (\vp -> ConP cofree [] [kPat, vp]) }  deriveCofreeInstance' :: Name -> Name -> Name -> Q [Dec]

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches -Wno-noncanonical-monoid-instances#-} {-# LANGUAGE     RankNTypes   , TypeFamilies@@ -100,7 +100,6 @@   fs <*> as = transform (\k f -> rightAdjunct (k . f) as) fs  instance Monad (Free c) where-  return = unit   as >>= f = transform (\k -> rightAdjunct k . f) as  instance (forall f x. Applicative f => c (Ap f (Free c x))) => Foldable (Free c) where

@@ -45,8 +45,6 @@ instance (c ~=> Monad, c (HFree c f)) => Monad (HFree c f) where   return = pure   HFree f >>= g = HFree $ \k -> f k >>= rightAdjunct k . g-  HFree f >> HFree g = HFree $ \k -> f k >> g k-  -- | Derive the instance of @`HFree` c f a@ for the class @c@,. --