generic-match (empty) → 0.1.0.0

raw patch · 5 files changed

+189/−0 lines, 5 filesdep +base

Dependencies added: base

Files

• CHANGELOG.md +5/−0
• Generic/Match.hs +118/−0
• LICENSE +7/−0
• README.md +35/−0
• generic-match.cabal +24/−0

@@ -0,0 +1,5 @@+# Revision history for generic-match++## 0.1.0.0 -- 2020-08-23++* First release to hackage, as a minimally useful implementation.

@@ -0,0 +1,118 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-}+module Generic.Match (match, Matcher) where++import Data.Foldable+import GHC.Generics+import Data.Void+import Prelude hiding (const)++-- | A first class pattern matching function for anything 'Generic', in the style of 'either' and+-- 'maybe'.+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++-- | The type of a first class pattern match, having consumed the input.+type Matcher x r = Matcher' (StripData (Rep x)) r++type family StripData g where+  StripData (D1 ('MetaData x0 x1 x2 x3) d) = d+++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++class Match g r where+  match' :: forall x. g x -> Matcher' g r+  const :: r -> Matcher' g r++instance Match V1 r where+  match' x = case x of+  const = id++instance Consume a => Match (C1 ('MetaCons x4 x5 x6) a) r where+  match' (M1 a) f = consume a f+  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)+  match' (R1 b) = \_ -> match' @b @r b++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++class Consume g where+  consume :: forall r x. g x -> Consumer g r -> r++instance Consume U1 where+  consume U1 r = r++instance Consume (S1 ('MetaSel x0 x1 x2 x3) (Rec0 x)) where+  consume (M1 (K1 x)) f = f x++instance Consume y => Consume (S1 ('MetaSel x0 x1 x2 x3) (Rec0 x) :*: y) where+  consume (M1 (K1 x) :*: y) f = consume y (f x) ++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 = ()++data Ploop = Clap Int Bool | Splop [Integer] Float | Flep [Int] [Float] [Bool] deriving Generic++newtype X = X { unX :: Int } 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)+  ]

@@ -0,0 +1,7 @@+Copyright 2020 Samuel Schlesinger++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,35 @@+# generic-match++When I'm writing Haskell code, often I write things like:++```haskell+x <- doThing >>= either errorHandler pure+y <- doOtherThing >>= maybe (throwIO Shriek) pure+```++This comes up in more places than error handling, but I think this is a+sufficient example. There is a compromise one makes with their API, where+they either offer a specific error type, and force you to deconstruct it and+fiddle with it on your own, but usually the names are more descriptive. On+the other hand, with Either or Maybe, we can use all of the standard functions+available for operating on them, such as either and maybe. This package is+getting rid of the cost of entry for deconstructing your own types in this+same style. Now we can write:++```haskell+data DatabaseAccess a =+    ConnectionFailure String+  | InvalidRowCount Int+  | Successful a+  deriving Generic+...+x <- doThing >>= match 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+```

@@ -0,0 +1,24 @@+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.+license:             MIT+license-file:        LICENSE+author:              Samuel Schlesinger+maintainer:          sgschlesinger@gmail.com+copyright:           2020 Samuel Schlesinger+category:            Data+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++source-repository head+  type: git+  location: https://github.com/samuelschlesinger/generic-match++library+  exposed-modules:     Generic.Match+  build-depends:       base >=4.12 && <4.15+  default-language:    Haskell2010