any-pat 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+218/−22 lines, 7 filesdep +QuickCheckdep +any-patdep +hspecdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, any-pat, hspec, parsec

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−10
• README.md +21/−3
• Setup.hs +1/−0
• any-pat.cabal +23/−1
• src/Data/Pattern/Any.hs +114/−8
• test/Data/Pattern/AnySpec.hs +43/−0
• test/Main.hs +11/−0

@@ -6,17 +6,12 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## 0.1.0.0 - 2023-07-23--<<<<<<< HEAD-The initial version of the project that exposes an `anypat` and `maypat` quasiquoter.-=======-## 0.1.0.0 - YYYY-MM-DD-# `any-pat` changelog- For a full list of changes, see the history on [*GitHub*](https://github.com/hapytex/any-pat). -## Version 0.1.0.0+## 0.2.0.0 - 2023-07-30 +Added `rangepat` to pattern match on ranges. ->>>>>>> 130aa316ac71a5c5b58b0955bd6dc104977443f3+## 0.1.0.0 - 2023-07-25++Initial version with `anypat` and `maypat`.

@@ -2,12 +2,16 @@ [![Build Status of the package by GitHub actions](https://github.com/hapytex/any-pat/actions/workflows/build-ci.yml/badge.svg)](https://github.com/hapytex/any-pat/actions/workflows/build-ci.yml) [![Hackage version badge](https://img.shields.io/hackage/v/any-pat.svg)](https://hackage.haskell.org/package/any-pat) -Combine multiple patterns in a single pattern.+Combine multiple patterns in a single pattern and range membership checks.  ## Usage -This package ships with two `QuasiQuoter`s: `anypat` and `maypat`. Both have the same purpose. Defining multiple possible patterns in a single clause. Indeed, consider the following example:+This package ships with three `QuasiQuoter`s: `anypat`, `maypat` and `rangepat`. +### `anypat` and `maypat`++`anypat` and `maypat` have the same purpose. Defining multiple possible patterns in a single clause. Indeed, consider the following example:+ ``` mightBe :: (Int, a, a) -> Maybe a mightBe (0, a, _) = Just a@@ -62,13 +66,25 @@ listToMaybe = [maypat|(a:_), _|] ``` +### `rangepat`++`rangepat` defines patterns for range memberships. For example:++```+isInRange :: Int -> Bool+isInRange [rangepat|0, 5 .. 50|] = True+isInRange _ = False+```++This will check in constant time if the number is in the given range (here `[0, 5 .. 50]`). The pattern has however some caveats, especially with floating point numbers, and likely any other type where `fromEnum` en `toEnum` are not *bijective*.+ ## Package structure  The package has only one module: `Data.Pattern.Any` that exports the two `QuasiQuoter`s named `anypat` and `maypat` together with some utility functions to obtain the variables names from a pattern.  ## Behind the curtains -The package transforms a sequence of patterns to a *view pattern*, or an *expression*, depending on where the quasi quoter is used. If we create a pattern <code>[anypat|p<sub>1</sub>, p<sub>2</sub>, &hellip;, p<sub>n</sub>|]</code>, it will create a view pattern that looks like:+The package transforms a sequence of patterns to a *view pattern*, or an *expression*, depending on where the quasi quoter is used. If we create a pattern <code>[anypat|p<sub>1</sub>, p<sub>2</sub>, &hellip;, p<sub>n</sub>]</code>, it will create a view pattern that looks like:  <pre><code>\case   p<sub>1</sub> -&gt; Just n&#8407;@@ -80,6 +96,8 @@ with <code>n&#8407;</code> the (sorted) tuple of names found in the patterns. It then makes a view pattern <code>e -&gt; n&#8407;</code> that thus maps the found values for the variables to the names that can then be used in the body of the function.  There are some (small) optimizations that for example are used if no variable names are used in the patterns, or only one. If a wildcard pattern is used, it can also omit the `Maybe` data type.++For `rangepat`, it first converts the range to a `RangeObj`, and then checks membership in constant time (given we assume that operations on `Int` run in constant time).  ## `any-pat` is **inferred** *safe* Haskell 

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,5 +1,5 @@ name:                any-pat-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Quasiquoters that act on a sequence of patterns and compiles these view into patterns and expressions. -- description: homepage:            https://github.com/hapytex/any-pat#readme@@ -31,6 +31,28 @@                        -Wincomplete-uni-patterns                        -Wmissing-home-modules                        -Wredundant-constraints++test-suite             all-pat+  type:                exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      test+  other-modules:+      Data.Pattern.AnySpec+  build-depends:+      base+    , any-pat+    , hspec ==2.*+    , parsec >=3.0+    , QuickCheck >=2.1+  build-tool-depends:+      hspec-discover:hspec-discover == 2.*+  default-language:    Haskell2010+  default-extensions:+  ghc-options:       -Wall -Wcompat -Wcompat+                     -Wincomplete-record-updates+                     -Wincomplete-uni-patterns+                     -Wredundant-constraints+  source-repository head   type:     git

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TupleSections #-} @@ -17,10 +18,16 @@   ( -- * Quasiquoters     anypat,     maypat,+    rangepat,      -- * derive variable names names from patterns     patVars,     patVars',++    -- * Range objects+    RangeObj (FromRange, FromThenRange, FromToRange, FromThenToRange),+    rangeToList,+    inRange,   ) where @@ -31,13 +38,37 @@ #endif import Data.List (sort) import Data.List.NonEmpty (NonEmpty ((:|)))-import Language.Haskell.Exts.Parser (ParseResult (ParseFailed, ParseOk), parsePat)-import Language.Haskell.Meta (toPat)-import Language.Haskell.TH (Body (NormalB), Exp (AppE, ConE, LamCaseE, TupE, VarE), Match (Match), Name, Pat (AsP, BangP, ConP, InfixP, ListP, LitP, ParensP, RecP, SigP, TildeP, TupP, UInfixP, UnboxedSumP, UnboxedTupP, VarP, ViewP, WildP), Q)+import Language.Haskell.Exts.Parser (ParseResult (ParseFailed, ParseOk), parseExp, parsePat)+import Language.Haskell.Meta (toExp, toPat)+import Language.Haskell.TH (Body (NormalB), Exp (AppE, ArithSeqE, ConE, LamCaseE, TupE, VarE), Match (Match), Name, Pat (AsP, BangP, ConP, InfixP, ListP, LitP, ParensP, RecP, SigP, TildeP, TupP, UInfixP, UnboxedSumP, UnboxedTupP, VarP, ViewP, WildP), Q, Range (FromR, FromThenR, FromThenToR, FromToR)) import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter))  data HowPass = Simple | AsJust | AsNothing deriving (Eq, Ord, Read, Show) +-- | A 'RangeObj' that specifies a range with a start value and optionally a step value and end value.+data RangeObj a+  = -- | A 'RangeObj' object that only has a start value, in Haskell specified as @[b ..]@.+    FromRange a+  | -- | A 'RangeObj' object that has a start value and end value, in Haskell specified as @[b .. e]@.+    FromThenRange a a+  | -- | A 'RangeObj' object with a start and next value, in Haskell specified as @[b, s ..]@.+    FromToRange a a+  | -- | A 'RangeObj' object with a start, next value and end value, in Haskell specified as @[b, s .. e]@.+    FromThenToRange a a a+  deriving (Eq, Functor, Read, Show)++-- | Convert the 'RangeObj' to a list of the values defined by the range.+rangeToList ::+  Enum a =>+  -- | The 'RangeObj' item to convert to a list.+  RangeObj a ->+  -- | A list of items the 'RangeObj' spans.+  [a]+rangeToList (FromRange b) = enumFrom b+rangeToList (FromThenRange b t) = enumFromThen b t+rangeToList (FromToRange b e) = enumFromTo b e+rangeToList (FromThenToRange b t e) = enumFromThenTo b t e+ -- | Provides a list of variable names for a given 'Pat'tern. The list is /not/ sorted. If the same variable name occurs multiple times (which does not make much sense), it will be listed multiple times. patVars' ::   -- | The 'Pat'tern to inspect.@@ -51,8 +82,8 @@ patVars' (TupP ps) = patVarsF ps patVars' (UnboxedTupP ps) = patVarsF ps patVars' (UnboxedSumP p _ _) = patVars' p-patVars' (InfixP p1 _ p2) = patVars' p1 . patVars' p2-patVars' (UInfixP p1 _ p2) = patVars' p1 . patVars' p2+patVars' (InfixP p₁ _ p₂) = patVars' p₁ . patVars' p₂+patVars' (UInfixP p₁ _ p₂) = patVars' p₁ . patVars' p₂ patVars' (ParensP p) = patVars' p patVars' (TildeP p) = patVars' p patVars' (BangP p) = patVars' p@@ -199,12 +230,40 @@ liftFail (ParseFailed _ s) = fail s  failQ :: a -> Q b-failQ = const (fail "The QuasiQuoter can only work to generate code as pattern.")+failQ = const (fail "The QuasiQuoter can only work to generate code as pattern or expression.") +parseRange :: String -> ParseResult Range+parseRange s = go (toExp <$> parseExp ('[' : s ++ "]"))+  where+    go (ParseOk (ArithSeqE r)) = pure r+    go _ = fail "Not a range expression"++-- | Convert a 'Range' objects from the 'Language.Haskell.TH' module to a 'RangeObj' with 'Exp' as parameters.+rangeToRangeObj ::+  -- | The 'Range' object to convert.+  Range ->+  -- | The equivalent 'RangeObj' with the 'Exp'ressions as parameters.+  RangeObj Exp+rangeToRangeObj (FromR b) = FromRange b+rangeToRangeObj (FromThenR b s) = FromThenRange b s+rangeToRangeObj (FromToR b e) = FromToRange b e+rangeToRangeObj (FromThenToR b s e) = FromThenToRange b s e++-- | Convert a 'RangeObj' to the corresponding 'Exp'ression. This will all the appropriate 'RangeObj' data constructor with the parameters.+rangeObjToExp ::+  -- | A 'RangeObj' with 'Exp'ressions as parameters.+  RangeObj Exp ->+  -- | An 'Exp'ression that contains the data constructor applied to the parameters.+  Exp+rangeObjToExp (FromRange b) = ConE 'FromRange `AppE` b+rangeObjToExp (FromThenRange b s) = ConE 'FromThenRange `AppE` b `AppE` s+rangeObjToExp (FromToRange b e) = ConE 'FromToRange `AppE` b `AppE` e+rangeObjToExp (FromThenToRange b s e) = ConE 'FromThenToRange `AppE` b `AppE` s `AppE` e+ -- | A quasquoter to specify multiple patterns that will succeed if any of the patterns match. All patterns should have the same set of variables and these should -- have the same type, otherwise a variable would have two different types, and if a variable is absent in one of the patterns, the question is what to pass as value. anypat ::-  -- | The quasiquoter that can be used as pattern.+  -- | The quasiquoter that can be used as expression and pattern.   QuasiQuoter anypat = QuasiQuoter ((liftFail >=> unionCaseExp True) . parsePatternSequence) ((liftFail >=> unionCaseFunc True) . parsePatternSequence) failQ failQ @@ -212,6 +271,53 @@ -- different patterns, it should have the same type. In case a variable name does not appear in all patterns, it will be passed as a 'Maybe' to the clause with 'Nothing' if a pattern matched -- without that variable name, and a 'Just' if the (first) pattern that matched had such variable. maypat ::-  -- | The quasiquoter that can be used as pattern.+  -- | The quasiquoter that can be used as expression and pattern.   QuasiQuoter maypat = QuasiQuoter ((liftFail >=> unionCaseExp False) . parsePatternSequence) ((liftFail >=> unionCaseFunc False) . parsePatternSequence) failQ failQ++_rangeCheck :: Int -> Int -> Int -> Bool+_rangeCheck b e x = b <= x && x <= e++_modCheck :: Int -> Int -> Int -> Bool+_modCheck b t x = (x - b) `mod` (t - b) == 0++-- | Check if the given value is in the given 'RangeObj'. This function has some caveats, especially with floating points or other 'Enum' instances+-- where 'fromEnum' and 'toEnum' are no bijections. For example for floating points, `12.5` and `12.2` both map on the same item, as a result, the enum+-- will fail to work properly.+inRange ::+  Enum a =>+  -- | The 'RangeObj' for which we check membership.+  RangeObj a ->+  -- | The element for which we check the membership.+  a ->+  -- 'True' if the element is an element of the 'RangeObj'; 'False' otherwise.+  Bool+inRange r = go (fromEnum <$> r) . fromEnum+  where+    go (FromRange b) = (b <=)+    go (FromToRange b e) = _rangeCheck b e+    go (FromThenRange b t)+      | EQ <- cmp = (b ==)+      | LT <- cmp = _both (b <=) (_modCheck b t)+      | otherwise = _both (b >=) (_modCheck b t)+      where+        cmp = compare b t+    go (FromThenToRange b t e)+      | EQ <- cmp, e >= b = (b ==)+      | LT <- cmp, e >= b = _both (_rangeCheck b e) (_modCheck b t)+      | GT <- cmp, e <= b = _both (_rangeCheck e b) (_modCheck b t)+      | otherwise = const False -- empty range+      where+        cmp = compare b t++_both :: (a -> Bool) -> (a -> Bool) -> a -> Bool+_both f g x = f x && g x++-- | A 'QuasiQuoter' to parse a range expression to a 'RangeObj'. In case the 'QuasiQuoter' is used for a pattern,+-- it compiles into a /view pattern/ that will work if the element is a member of the 'RangeObj'.+rangepat ::+  -- | The quasiquoter that can be used as expression and pattern.+  QuasiQuoter+rangepat = QuasiQuoter (parsefun id) (parsefun ((`ViewP` conP 'True []) . (VarE 'inRange `AppE`))) failQ failQ+  where+    parsefun pp = (liftFail >=> (pure . pp . rangeObjToExp . rangeToRangeObj)) . parseRange

@@ -0,0 +1,43 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE TypeApplications #-}++module Data.Pattern.AnySpec where++import Data.Bool(bool)+import Data.Int(Int8, Int16)+import Data.Pattern.Any (RangeObj (FromRange, FromThenRange, FromThenToRange, FromToRange), inRange, rangeToList)+import Data.Word (Word16, Word8)+import Test.Hspec (describe, it)+import Test.Hspec.Discover (Spec)+import Test.QuickCheck (property)+import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))+import Test.QuickCheck.Gen (oneof)++allSame :: Eq a => RangeObj a -> Bool+allSame (FromThenRange a b) = a == b+allSame (FromThenToRange a b _) = a == b+allSame _ = False++instance Arbitrary a => Arbitrary (RangeObj a) where+  arbitrary = oneof [FromRange <$> arbitrary, FromThenRange <$> arbitrary <*> arbitrary, FromToRange <$> arbitrary <*> arbitrary, FromThenToRange <$> arbitrary <*> arbitrary <*> arbitrary]++testInRange :: forall a. (Enum a, Eq a) => RangeObj a -> a -> Bool+testInRange r x = (x `elem` bool id (take 10) (allSame r) (rangeToList r)) == inRange r x++allInRange :: forall a . (Enum a, Eq a) => RangeObj a -> a -> Bool+allInRange r x = all (inRange r) (bool id (take 10) (allSame r) (rangeToList r))++spec :: Spec+spec = do+  describe "range membership check" $ do+    it "Int8" (property (testInRange @Int8))+    it "Int16" (property (testInRange @Int16))+    it "Word8" (property (testInRange @Word8))+    it "Word16" (property (testInRange @Word16))+    it "Char" (property (testInRange @Char))+  describe "all in range membercheck" $ do+    it "Int8" (property (allInRange @Int8))+    it "Int16" (property (allInRange @Int16))+    it "Word8" (property (allInRange @Word8))+    it "Word16" (property (allInRange @Word16))+    it "Char" (property (allInRange @Char))

@@ -0,0 +1,11 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+-- cabal v2-test --test-show-details=direct+-- cabal v2-test --test-show-details=direct --test-options="--color --format=progress"++module Main++-- main :: IO ExitCode+-- main = runAllLiquid++-- runAllLiquid :: IO ExitCode+-- runAllLiquid = mconcat <$> mapM runLiquid orderedSrcFiles