diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.2 + +- Supports `deriving via (Generically1 f)` + # 0.1.2.1 - No changes to the library itself. The package description (.cabal file) diff --git a/matchable.cabal b/matchable.cabal --- a/matchable.cabal +++ b/matchable.cabal @@ -1,5 +1,5 @@ name: matchable -version: 0.1.2.1 +version: 0.2 synopsis: A type class for Matchable Functors. description: This package defines a type class @Matchable@, providing @zipMatch@ operation for zipping two values of any container-like @@ -13,7 +13,7 @@ extra-source-files: README.md extra-doc-files: CHANGELOG.md cabal-version: 2.0 -tested-with: GHC ==9.0.2, GHC ==9.2.7, GHC ==9.4.4, GHC ==9.6.1 +tested-with: GHC ==9.2.8, GHC ==9.4.8, GHC ==9.6.6, GHC ==9.8.2, GHC ==9.10.1 source-repository head type: git @@ -25,11 +25,13 @@ exposed-modules: Data.Matchable , Data.Bimatchable build-depends: base >=4.10 && <5, - containers >=0.5.10.2 && <0.7, + base-orphans >=0.9.3 && <1, + containers >=0.5.10.2 && <0.8, tagged >=0.8 && <0.9, - hashable >=1.0.1.1 && <1.5, + hashable >=1.0.1.1 && <1.6, unordered-containers >=0.2.6 && <0.3, - vector >=0.10.9.0 && <0.14 + vector >=0.10.9.0 && <0.14, + generically >=0.1 ghc-options: -Wall default-language: Haskell2010 @@ -37,6 +39,6 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: example.hs - build-depends: base, containers, matchable, hspec + build-depends: base, containers, matchable, generically, hspec default-language: Haskell2010 diff --git a/src/Data/Matchable.hs b/src/Data/Matchable.hs --- a/src/Data/Matchable.hs +++ b/src/Data/Matchable.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Matchable( -- * Matchable class Matchable(..), @@ -17,7 +18,8 @@ import Control.Applicative -import Data.Functor.Classes +import Data.Functor.Classes ( Eq1 ) +import Data.Orphans() import Data.Maybe (fromMaybe, isJust) import Data.Foldable @@ -48,7 +50,18 @@ import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap -import GHC.Generics +import GHC.Generics + ( Generic1(..), + V1, + U1(..), + Par1(Par1), + Rec1(Rec1), + K1(K1), + M1(M1), + type (:+:)(..), + type (:*:)(..), + type (:.:)(Comp1) ) +import GHC.Generics.Generically ( Generically1(..) ) -- $setup -- This is required to silence "type defaults" warning, which clutters GHCi @@ -228,30 +241,32 @@ HashMap.traverseWithKey (\k a -> u a =<< HashMap.lookup k bs) as | otherwise = Nothing --- * Generic definition +instance (Generic1 f, Matchable' (Rep1 f)) => Matchable (Generically1 f) where + zipMatchWith f (Generically1 x) (Generically1 y) = Generically1 <$> genericZipMatchWith f x y -{-| +{- * Generic definition An instance of Matchable can be implemened through GHC Generics. -You only need to do two things: Make your type @Functor@ and @Generic1@. +As a prerequisite, you need to make your type an instance of 'Functor' and 'Generic1'. +Both of them can be derived using DeriveFunctor and DeriveGeneric extension. -==== Example +Using 'Generically1' and DerivingVia extension, @Matchable@ instance can be automatically derived. + >>> :set -XDeriveFunctor >>> :set -XDeriveGeneric +>>> :set -XDerivingVia >>> :{ data MyTree label a = Leaf a | Node label [MyTree label a] - deriving (Show, Read, Eq, Ord, Functor, Generic1) + deriving stock (Show, Read, Eq, Ord, Functor, Generic1) + deriving (Eq1, Matchable) via (Generically1 (MyTree label)) :} -Then you can use @genericZipMatchWith@ to implement @zipMatchWith@ method. -You also need @Eq1@ instance, but 'liftEqDefault' is provided. +Alternatively, you can use 'genericZipMatchWith' to manually define @zipMatchWith@ method. ->>> :{ - instance (Eq label) => Matchable (MyTree label) where - zipMatchWith = genericZipMatchWith - instance (Eq label) => Eq1 (MyTree label) where - liftEq = liftEqDefault - :} +> instance (Eq label) => Matchable (MyTree label) where +> zipMatchWith = genericZipMatchWith +> instance (Eq label) => Eq1 (MyTree label) where +> liftEq = liftEqDefault >>> zipMatch (Node "foo" [Leaf 1, Leaf 2]) (Node "foo" [Leaf 'a', Leaf 'b']) Just (Node "foo" [Leaf (1,'a'),Leaf (2,'b')]) @@ -261,7 +276,7 @@ Nothing -} -class Matchable' t where +class (Functor t, Eq1 t) => Matchable' t where zipMatchWith' :: (a -> b -> Maybe c) -> t a -> t b -> Maybe (t c) -- | zipMatchWith via Generics. diff --git a/test/example.hs b/test/example.hs --- a/test/example.hs +++ b/test/example.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} module Main(main) where import Data.Bifunctor @@ -10,6 +11,7 @@ import qualified Data.Map as Map import GHC.Generics (Generic1) +import GHC.Generics.Generically (Generically1(..)) import Test.Hspec @@ -115,13 +117,8 @@ map3 = Map.fromList [pair1] data MyTree k a = Empty | Node k a (MyTree k a) (MyTree k a) - deriving (Show, Eq, Functor, Generic1) - -instance Eq k => Eq1 (MyTree k) where - liftEq = liftEqDefault - -instance Eq k => Matchable (MyTree k) where - zipMatchWith = genericZipMatchWith + deriving stock (Show, Read, Eq, Ord, Functor, Generic1) + deriving (Eq1, Matchable) via (Generically1 (MyTree k)) myTree1 :: MyTree Int String myTree1 = Node 0 "foo" Empty (Node 1 "bar" Empty Empty)