generic-match 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+137/−17 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Generic.Match: class Consume g
+ Generic.Match: class Generic a
+ Generic.Match: class Match g r
+ Generic.Match: instance GHC.Generics.Generic Generic.Match.Klop
+ Generic.Match: type family Consumer x r
Files
- Generic/Match.hs +120/−10
- README.md +3/−3
- generic-match.cabal +14/−4
Generic/Match.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-}@@ -14,52 +15,158 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-}-module Generic.Match (match, Matcher) where+{- |+Name: Generic.Match+Description: First class pattern matching for GHC.Generics.+Copyright: 2020-2024 Samuel Schlesinger+License: MIT+-}+module Generic.Match+(+-- * Pattern match on a 'Generic' type+ match+-- * Type classes+, Match+, Consume+-- * Type families+, Matcher+, StripData+, Matcher'+, Consumer+-- * Re-exported from GHC.Generics+, Generic+) where import Data.Foldable import GHC.Generics import Data.Void-import Prelude hiding (const)+import Prelude -- | A first class pattern matching function for anything 'Generic', in the style of 'either' and--- 'maybe'.+-- 'maybe', but with the first argument being the thing you are pattern+-- matching on, as opposed to the last argument.+--+-- @either f g x == match x f g@+--+-- @maybe r f x == match x r f@+--+-- Beyond working for 'Maybe' or 'Either', this function works on just+-- about any type you give to it, as long as that type has a 'Generic'+-- instance. For example, this code is from the tests which are not+-- exported from this file:+--+-- @+-- data Ploop =+-- Clap Int Bool+-- | Splop [Integer] Float+-- | Flep [Int] [Float] [Bool]+-- deriving Generic+-- +-- newtype X = X { unX :: Int } deriving Generic+--+-- data Klop = Cloop Klop+-- deriving Generic+--+-- tests :: Bool+-- tests = and+-- [ match True False True+-- , match False True False+-- , match (Left (5 :: Int)) (== 5) undefined+-- , match (Right ([1,2] :: [Int])) undefined ((== 2) . length)+-- , match (Clap 0 True) (\i b -> i == 0 && b) undefined undefined+-- , match (X 1) (\x -> x == 1)+-- , match (let x = Cloop x in x) (\_ -> True)+-- ]+-- @+--+-- There are other tests as well, at the type level, which I used to+-- develop this library, and I think it makes sense to display those as+-- well:+--+-- @+-- facts :: ()+-- facts = fold+-- [ unitMatcher+-- , boolMatcher+-- , thingMatcher+-- , pairMatcher+-- , tripleMatcher+-- , voidMatcher+-- ]+--+-- unitMatcher :: Matcher () r ~ (r -> r) => ()+-- unitMatcher = ()+-- +-- boolMatcher :: Matcher Bool r ~ (r -> r -> r) => ()+-- boolMatcher = ()+-- +-- data Thing = Thing Bool+-- deriving Generic+--+-- thingMatcher :: Matcher Thing r ~ ((Bool -> r) -> r) => ()+-- thingMatcher = ()+-- +-- pairMatcher :: Matcher (Int, Bool) r ~ ((Int -> Bool -> r) -> r) => ()+-- pairMatcher = ()+-- +-- tripleMatcher :: Matcher (Int, Int, Int) r ~ ((Int -> Int -> Int -> r) -> r) => ()+-- tripleMatcher = ()+-- +-- voidMatcher :: Matcher Void r ~ r => ()+-- voidMatcher = ()+-- @+--+-- These may look strange to the reader, but the way to read them is that+-- the constraint to the left of the fat arrow must be true if I can+-- instantiate one of the terms in a context without assuming it. As+-- I instantiate all of them in that 'fold' (possibly the only use of the+-- '()' monoid that I can think of, all of these constraints must be true.+-- This allowed me to develop this library by making instances that made+-- each new constraint I added true. match :: forall b r a x0 x1 x2 x3. (Generic b, Match a r, Rep b ~ D1 ('MetaData x0 x1 x2 x3) a) => b -> Matcher b r-match (from -> M1 a) = match' @a @r a+match (from -> M1 a) = match' @a @r a -- | The type of a first class pattern match, having consumed the input. type Matcher x r = Matcher' (StripData (Rep x)) r +-- | The type family that strips the 'MetaData' off of a 'GHC.Generics'+-- 'Rep'resentation. type family StripData g where StripData (D1 ('MetaData x0 x1 x2 x3) d) = d -+-- | The utility family which defines a 'Matcher', after stripping the+-- metadata from the top level of the 'GHC.Generics' 'Rep'resentation.. type family Matcher' x r where Matcher' V1 r = r Matcher' (C1 ('MetaCons x4 x5 x6) a) r = Consumer a r -> r Matcher' (C1 ('MetaCons x4 x5 x6) a :+: b) r = Consumer a r -> Matcher' b r +-- | The class that is used to inductively define the pattern matching for+-- a particular generic type. class Match g r where match' :: forall x. g x -> Matcher' g r- const :: r -> Matcher' g r+ const' :: r -> Matcher' g r instance Match V1 r where match' x = case x of- const = id+ const' = id instance Consume a => Match (C1 ('MetaCons x4 x5 x6) a) r where match' (M1 a) f = consume a f- const r _ = r+ const' r _ = r instance (Consume a, Match b r) => Match (C1 ('MetaCons x4 x5 x6) a :+: b) r where- const r _ = const @b r- match' (L1 (M1 a)) = \c -> const @b @r (consume @a a c)+ const' r _ = const' @b r+ match' (L1 (M1 a)) = \c -> const' @b @r (consume @a a c) match' (R1 b) = \_ -> match' @b @r b +-- | The type family that describes how to consume a product inside of a 'Generic' type. type family Consumer x r where Consumer U1 r = r Consumer (S1 ('MetaSel x0 x1 x2 x3) (Rec0 x)) r = x -> r Consumer (S1 ('MetaSel x0 x1 x2 x3) (Rec0 x) :*: y) r = x -> Consumer y r +-- | The typeclass used to consume a product inside of a 'Generic' type. class Consume g where consume :: forall r x. g x -> Consumer g r -> r @@ -107,6 +214,8 @@ newtype X = X { unX :: Int } deriving Generic +data Klop = Cloop Klop deriving Generic+ tests :: Bool tests = and [ match True False True@@ -115,4 +224,5 @@ , match (Right ([1,2] :: [Int])) undefined ((== 2) . length) , match (Clap 0 True) (\i b -> i == 0 && b) undefined undefined , match (X 1) (\x -> x == 1)+ , match (let x = Cloop x in x) (\_ -> True) ]
README.md view
@@ -23,13 +23,13 @@ | Successful a deriving Generic ...-x <- doThing >>= match error (error . show) pure+x <- doThing >>= \g -> match g error (error . show) pure ``` This is the motivating case, but there are many others! For instance, you can also replace your use of either and maybe with the more "Generic" (heh) match. ```haskell-x <- doThing >>= match errorHandler pure-y <- doOtherThing >>= match (throwIO Shriek) pure+x <- doThing >>= \g -> match g errorHandler pure+y <- doOtherThing >>= \g -> match g (throwIO Shriek) pure ```
generic-match.cabal view
@@ -1,8 +1,8 @@ cabal-version: 2.4 name: generic-match-version: 0.1.0.0-synopsis: For when first class pattern matches are needed-description: For when first class pattern matches are needed.+version: 0.2.0.0+synopsis: First class pattern matching+description: First class pattern matching. license: MIT license-file: LICENSE author: Samuel Schlesinger@@ -12,7 +12,17 @@ extra-source-files: CHANGELOG.md, README.md build-type: Simple extra-source-files: CHANGELOG.md-tested-with: GHC ==8.6.3 || ==8.8.3 || ==8.10.1+tested-with: GHC ==8.6.1 ||+ ==8.6.2 ||+ ==8.6.3 ||+ ==8.6.4 ||+ ==8.6.5 ||+ ==8.8.1 ||+ ==8.8.2 ||+ ==8.8.3 ||+ ==8.8.4 ||+ ==8.10.1 ||+ ==8.10.2 source-repository head type: git