any-pat 0.2.0.0 → 0.3.0.0

raw patch · 5 files changed

+318/−79 lines, 5 filesdep +unordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +49/−16
• any-pat.cabal +2/−1
• src/Data/Pattern/Any.hs +190/−56
• test/Data/Pattern/AnySpec.hs +73/−6

@@ -8,6 +8,10 @@  For a full list of changes, see the history on [*GitHub*](https://github.com/hapytex/any-pat). +## 0.3.0.0 - 2023-12-25++Added `hashpat` to perform `HashMap` lookups.+ ## 0.2.0.0 - 2023-07-30  Added `rangepat` to pattern match on ranges.

@@ -13,7 +13,7 @@ `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 ∷ (Int, a, a) → Maybe a mightBe (0, a, _) = Just a mightBe (1, _, a) = Just a mightBe _ = Nothing@@ -25,7 +25,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ViewPatterns #-} -mightBe :: (Int, a, a) -> Maybe a+mightBe ∷ (Int, a, a) → Maybe a mightBe [anypat|(0, a, _), (1, _, a)|] = Just a mightBe _ = Nothing ```@@ -36,7 +36,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ViewPatterns #-} -mightBe :: (Int, a, a) -> Maybe a+mightBe ∷ (Int, a, a) → Maybe a mightBe [maypat|(0, a _), (1, _, a), _|] = a ``` @@ -47,31 +47,61 @@ ``` {-# LANGUAGE QuasiQuotes #-} -mightBe :: (Int, a, a) -> Maybe a+mightBe ∷ (Int, a, a) → Maybe a mightBe = [maypat|(0, a _), (1, _, a), _|] ```  If it is used as pattern, the `ViewPatterns` language extension should be enabled. Furthermore the `QuasiQuotes` extension should of course be enabled for any use of the quasi quoters. -The difference between the two `QuasiQuoter`s (`anypat` and `maypat`) are the handling of variable names. Variable names defined in the pattern(s) are used in the body of the function, so it makes sense that if the clause "fires", these have a value. This thus means that a reasonable condition is that all patterns have the same set of variable names and that the variable names have the same type. The `anypat` requires that all patterns have the same variables, so `[anypat|(0, a), (1, _)|]` will raise an error: if the second pattern `(1, _)` would "fire" it would not provide a value for the `a` variable, and then we have a problem. A possible solution would be to pass a value like `undefined`, or an infinite loop (i.e. `y = let x = x in x` for example) as value, but this looks like something that would only cause a lot of trouble.+The difference between the two QuasiQuoters (`anypat` and `maypat`) is in how they handle variable names. Variable names defined in the patterns are used in the body of the function, so it makes sense that if the clause "fires", they have a value. This means that a reasonable condition is that all patterns have the same set of variable names and that the variable names have the same type. -Therefore `maypat` comes with a different solution: it performs analysis on the variables used in the different patterns. Variables that occur in all patterns are just passed with the real value, variables that occur only in a (strict) subset of the listed patterns, are passed as a `Maybe a` value with `Just x` in case the first pattern that "fires" (left-to-right) for the value has that variable, it will be wrapped in a `Just`, and otherwise, it will pass `Nothing` as that variable.+The `anypat` requires that all patterns have the same variables. So, `[anypat|(0, a), (1, _)|]` will raise an error *at compile time*. This is because if the second pattern `(1, _)` "fires", it will not provide a value for the a variable. This is a problem, because the body of the function expects a value for the a variable. -Some functions in the `base` package, for example, have a simple equivalent with `anypat` or `maypat`, for example [**`listToMaybe :: [a] -> Maybe a`**](https://hackage.haskell.org/package/base-4.18.0.0/docs/Data-Maybe.html#v:listToMaybe) can be implemented as:+One possible solution would be to pass a value like `undefined` or an infinite loop (i.e. `y = let x = x in x` for example) as the value for the a variable. However, this is not a good solution, because it would cause a lot of trouble. +Therefore, `maypat` comes with a different solution. It performs analysis on the variables used in the different patterns. Variables that occur in all patterns are simply passed with the real value. Variables that occur only in a (strict) subset of the listed patterns are passed as a `Maybe a` value. If the first pattern that "fires" (left-to-right) for the value has that variable, it will be wrapped in a `Just`. Otherwise, it will pass `Nothing` as that variable.++Some functions in the `base` package, for example, have a simple equivalent with `anypat` or `maypat`, for example [**`listToMaybe ∷ [a] → Maybe a`**](https://hackage.haskell.org/package/base-4.18.0.0/docs/Data-Maybe.html#v:listToMaybe) can be implemented as:+ ``` {-# LANGUAGE QuasiQuotes #-} -listToMaybe :: [a] -> Maybe a+listToMaybe ∷ [a] → Maybe a listToMaybe = [maypat|(a:_), _|] ``` +### `hashpat`++`hashpat` is a quasi quoter for patterns to make lookups on `HashMap`s more convenient. Indeed, we can for example create a function:++```+sumab :: HashMap String Int -> Int+sumab [hashpat|"a" -> a, "b" -> b|] = a + b+sumab _ = 0+```++this will "fire" the first clause given the `HashMap` has both an `"a"` and `"b"` as key, and it will thus perform the corresponding lookups and unify `a` and `b` with the corresponding output. This thus means that a `HashMap` that contains `"a"` and `"b"`, we will sum up the values for that `HashMap`, and if not return `0`.++The keys can take arbitrary expressions, and we thus can for example use `"a" ++ "b"` as key. Furthermore we can use an arbitrary pattern at the right side of the arrow, such that it only "fires" if it matches a given pattern. For example:++```+bifanothing :: HashMap String (Maybe Int) -> Int+bifanothing [hashpat|"a" ++ "b" -> Nothing, "b" -> Just x|] = x+bifanothing _ = 0+```++this will thus fire the first clause if the `HashMap` has a key `"ab"` that maps to `Nothing`, and a key `"b"` that maps to a `Just x`, and in that case return the `x`. Essentially it thus compiles the pattern, which is a sequence of view patterns into a function that will perform `lookup`s and then pattern match on the result of these lookups.++ ### `rangepat`  `rangepat` defines patterns for range memberships. For example:  ```-isInRange :: Int -> Bool+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ViewPatterns #-}++isInRange ∷ Int → Bool isInRange [rangepat|0, 5 .. 50|] = True isInRange _ = False ```@@ -87,19 +117,19 @@ 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;-  p<sub>2</sub> -&gt; Just n&#8407;-  &vellip;-  p<sub>n</sub> -&gt; Just n&#8407;-  _ -&gt; Nothing</code></pre>+  p<sub>1</sub> &rarr; Just n&#8407;+  p<sub>2</sub> &rarr; Just n&#8407;+  &vellip;   &vellip;    &vellip;+  p<sub>n</sub> &rarr; Just n&#8407;+  _ &rarr; Nothing</code></pre> -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.+with <code>n&#8407;</code> the (sorted) tuple of names found in the patterns. It then makes a view pattern <code>e &rarr; 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+## `any-pat` is ***inferred** safe* Haskell  It can not be marked safe, since the modules it depends on are not marked safe, but its safeness can be inferred by the compiler. @@ -111,3 +141,6 @@ You can contact the package maintainer by sending a mail to [`hapytexeu+gh@gmail.com`](mailto:hapytexeu+gh@gmail.com). +---++This package is dedicated to professor <abbr title="for the Pat-rick of course.">**P̲a̲t̲**rick</abbr> De Causmaecker, who taught most of the basic programming courses at university, not Haskell however.

@@ -1,5 +1,5 @@ name:                any-pat-version:             0.2.0.0+version:             0.3.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@@ -21,6 +21,7 @@   build-depends:       base >= 4.7 && < 5     , template-haskell >= 2.2.0.0+    , unordered-containers >=0.1     , haskell-src-exts     , haskell-src-meta   default-language:    Haskell2010

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TupleSections #-} @@ -19,15 +20,29 @@     anypat,     maypat,     rangepat,+    hashpat,+    ϵ, +    -- * compile hash patterns+    combineHashViewPats,+     -- * derive variable names names from patterns     patVars,     patVars',      -- * Range objects-    RangeObj (FromRange, FromThenRange, FromToRange, FromThenToRange),+    RangeObj (RangeObj, rangeBegin, rangeThen, rangeEnd),+    pattern FromRange,+    pattern FromThenRange,+    pattern FromToRange,+    pattern FromThenToRange,     rangeToList,     inRange,+    (∈),+    (∋),+    rangeLength,+    rangeDirection,+    rangeLastValue,   ) where @@ -36,27 +51,55 @@ # if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail) #endif+import Data.HashMap.Strict (lookup) import Data.List (sort) import Data.List.NonEmpty (NonEmpty ((:|)))-import Language.Haskell.Exts.Parser (ParseResult (ParseFailed, ParseOk), parseExp, parsePat)+import Language.Haskell.Exts.Extension (Extension (EnableExtension), KnownExtension (ViewPatterns))+import Language.Haskell.Exts.Parser (ParseMode (extensions), ParseResult (ParseFailed, ParseOk), defaultParseMode, parseExp, parsePatWithMode) 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 (Body (NormalB), Exp (AppE, ArithSeqE, ConE, LamCaseE, LamE, 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), newName) 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+data RangeObj a = RangeObj {rangeBegin :: a, rangeThen :: Maybe a, rangeEnd :: Maybe a}   deriving (Eq, Functor, Read, Show) +-- | A 'RangeObj' object that only has a start value, in Haskell specified as @[b ..]@.+pattern FromRange :: a -> RangeObj a+pattern FromRange b = RangeObj b Nothing Nothing++-- | A 'RangeObj' object that has a start value and end value, in Haskell specified as @[b .. e]@.+pattern FromThenRange :: a -> a -> RangeObj a+pattern FromThenRange b e = RangeObj b (Just e) Nothing++-- | A 'RangeObj' object with a start and next value, in Haskell specified as @[b, s ..]@.+pattern FromToRange :: a -> a -> RangeObj a+pattern FromToRange b t = RangeObj b Nothing (Just t)++-- | A 'RangeObj' object with a start, next value and end value, in Haskell specified as @[b, s .. e]@.+pattern FromThenToRange :: a -> a -> a -> RangeObj a+pattern FromThenToRange b t e = RangeObj b (Just t) (Just e)++-- | Determine the last value of a 'RangeObj', given the 'RangeObj' has an /explicit/ end value.+-- The last value is /not/ per se the end value. For example for @[0, 3 .. 10]@, the last value will+-- be @9@. If the 'RangeObj' is empty, or has no (explicit) end value, 'Nothing' is returned.+rangeLastValue :: Enum a => RangeObj a -> Maybe a+rangeLastValue (RangeObj b Nothing e@(Just e'))+  | fromEnum b <= fromEnum e' = e+rangeLastValue (RangeObj b' jt@(Just t') (Just e'))+  | EQ <- c, e >= b = jt -- we reuse the item in the 'RangeObj' to save memory+  | LT <- c, b < e = Just (toEnum (e - ((e - b) `mod` d)))+  | GT <- c, b > e = Just (toEnum (e - ((e - b) `mod` d)))+  where+    c = compare b t+    b = fromEnum b'+    t = fromEnum t'+    e = fromEnum e'+    d = t - b+rangeLastValue _ = Nothing+ -- | Convert the 'RangeObj' to a list of the values defined by the range. rangeToList ::   Enum a =>@@ -64,10 +107,10 @@   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+rangeToList (RangeObj b Nothing Nothing) = enumFrom b+rangeToList (RangeObj b (Just t) Nothing) = enumFromThen b t+rangeToList (RangeObj b Nothing (Just e)) = enumFromTo b e+rangeToList (RangeObj b (Just t) (Just 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' ::@@ -143,7 +186,7 @@ bodyPat :: Bool -> [Name] -> (Exp, Pat) bodyPat _ [] = (ConE 'False, conP 'True []) bodyPat b [n] = (ConE 'Nothing, wrapIt (conP 'Just . pure) b (VarP n))-bodyPat b ns = (ConE 'Nothing, wrapIt (conP 'Just . pure) b (TildeP (TupP (map VarP ns))))+bodyPat b ns = (ConE 'Nothing, wrapIt (conP 'Just . pure) b (TupP (map VarP ns)))  transName' :: HowPass -> Name -> Exp transName' Simple = VarE@@ -202,27 +245,23 @@ unionCaseExp :: MonadFail m => Bool -> NonEmpty Pat -> m Exp unionCaseExp = unionCaseFuncWith fst -#if MIN_VERSION_template_haskell(2,18,0) parsePatternSequence :: String -> ParseResult (NonEmpty Pat)-parsePatternSequence s = go (toPat <$> parsePat ('(' : s ++ ")"))-  where-    go (ParseOk (ConP n [] [])) | n == '() = fail "no patterns specified"-    go (ParseOk (ParensP p)) = pure (p :| [])-    go (ParseOk (TupP [])) = fail "no patterns specified"-    go (ParseOk (TupP (p : ps))) = pure (p :| ps)-    go (ParseOk _) = fail "not a sequence of patterns"-    go (ParseFailed l m) = ParseFailed l m-#else-parsePatternSequence :: String -> ParseResult (NonEmpty Pat)-parsePatternSequence s = go (toPat <$> parsePat ('(' : s ++ ")"))-  where-    go (ParseOk (ConP n [])) | n == '() = fail "no patterns specified"-    go (ParseOk (ParensP p)) = pure (p :| [])-    go (ParseOk (TupP [])) = fail "no patterns specified"-    go (ParseOk (TupP (p : ps))) = pure (p :| ps)-    go (ParseOk _) = fail "not a sequence of patterns"-    go (ParseFailed l m) = ParseFailed l m+parsePatternSequence s = parsePatWithMode (defaultParseMode {extensions = [EnableExtension ViewPatterns]}) ('(' : s ++ ")") >>= _getPats . toPat +#if MIN_VERSION_template_haskell(2,18,0)+_getPats :: Pat -> ParseResult (NonEmpty Pat)+_getPats (ConP n [] []) | n == '() = fail "no patterns specified"+_getPats (ParensP p) = pure (p :| [])+_getPats (TupP []) = fail "no patterns specified"+_getPats (TupP (p : ps)) = pure (p :| ps)+_getPats _ = fail "not a sequence of patterns"+#else+_getPats :: Pat -> ParseResult (NonEmpty Pat)+_getPats (ConP n []) | n == '() = fail "no patterns specified"+_getPats (ParensP p) = pure (p :| [])+_getPats (TupP []) = fail "no patterns specified"+_getPats (TupP (p : ps)) = pure (p :| ps)+_getPats _ = fail "not a sequence of patterns" #endif  liftFail :: MonadFail m => ParseResult a -> m a@@ -255,10 +294,10 @@   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+rangeObjToExp (RangeObj b t e) = ConE 'RangeObj `AppE` b `AppE` go t `AppE` go e+  where+    go (Just v) = ConE 'Just `AppE` v+    go Nothing = ConE 'Nothing  -- | 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.@@ -275,12 +314,85 @@   QuasiQuoter maypat = QuasiQuoter ((liftFail >=> unionCaseExp False) . parsePatternSequence) ((liftFail >=> unionCaseFunc False) . parsePatternSequence) failQ failQ +#if MIN_VERSION_template_haskell(2, 16, 0)+_makeTupleExpressions :: Name -> [Pat] -> Q ([Maybe Exp], [Pat])+_makeTupleExpressions hm = go [] [] . reverse+  where+    go es ps [] = pure (es, ps)+    go es ps (ViewP e p : xs) = go (Just (VarE 'Data.HashMap.Strict.lookup `AppE` e `AppE` VarE hm) : es) (conP 'Just [p] : ps) xs+    go _ _ _ = fail "all items in the hashpat should look like view patterns."+#else+_makeTupleExpressions :: Name -> [Pat] -> Q ([Exp], [Pat])+_makeTupleExpressions hm = go [] [] . reverse+  where+    go es ps [] = pure (es, ps)+    go es ps (ViewP e p : xs) = go (VarE 'Data.HashMap.Strict.lookup `AppE` e `AppE` VarE hm : es) (conP 'Just [p] : ps) xs+    go _ _ _ = fail "all items in the hashpat should look like view patterns."+#endif++-- | Create a view pattern that maps a HashMap with a locally scoped @hm@ parameter to a the patterns. It thus basically implicitly adds `lookup`+-- to all expressions and matches these with the given patterns. The compilation fails if not all elements are view patterns.+combineHashViewPats ::+  -- | The non-empty list of view patterns that are compiled into a viw pattern.+  NonEmpty Pat ->+  -- | A 'Pat' that is a view pattern that will map a 'Data.HashMap.Strict.HashMap' to make lookups and matches these with the given patterns.+  Q Pat+combineHashViewPats (ViewP e p :| []) = pure (ViewP (AppE (VarE 'Data.HashMap.Strict.lookup) e) (conP 'Just [p]))+combineHashViewPats (x :| xs) = do+  hm <- newName "hm"+  uncurry ((. TupP) . (ViewP . LamE [VarP hm] . TupE)) <$> _makeTupleExpressions hm (x : xs)++-- | A quasiquoter to make `Data.HashMap.Strict.HashMap` lookups more convenient. This can only be used as a pattern.+hashpat :: QuasiQuoter+hashpat = QuasiQuoter failQ ((liftFail >=> combineHashViewPats) . 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 +-- | Determine the number of items for a 'RangeObj', given that can be determined /easily/. This is only for ranges that+-- have an /end/ and where the next item is different from the previous (otherwise this generates an endless list).+rangeLength ::+  Enum a =>+  -- | The 'RangeObj' to determine the number of elements from.+  RangeObj a ->+  -- | The number of elements of the range object, given that can be determined easily; 'Nothing' otherwise.+  Maybe Int+rangeLength = fmap (max 0) . go . fmap fromEnum+  where+    go (RangeObj b t (Just e))+      | Just t' <- t, b == t' = go'+      | otherwise = Just (maybe id (flip div . subtract b) t (e - b) + 1)+      where+        go'+          | b <= e = Nothing+          | otherwise = Just 0+    go _ = Nothing++_forOrdering :: a -> a -> a -> Ordering -> a+_forOrdering lt eq gt = go+  where+    go LT = lt+    go EQ = eq+    go GT = gt++-- | Determine the direction of the range through an 'Ordering' object. For an increasing sequence, 'LT' is used, for a sequence that repeats the element, 'Eq' is returned,+-- and for a descreasing sequence 'GT' is used.+rangeDirection ::+  Ord a =>+  -- | The 'RangeObj' to determine the direction.+  RangeObj a ->+  -- | The direction of the 'RangeObj' as an 'Ordering' object.+  Ordering+rangeDirection (RangeObj _ Nothing _) = LT+rangeDirection (RangeObj b (Just t) _) = compare b t++_incCheck :: Ord a => a -> Maybe a -> Bool+_incCheck _ Nothing = True+_incCheck m (Just n) = m <= n+ -- | 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.@@ -292,24 +404,38 @@   a ->   -- 'True' if the element is an element of the 'RangeObj'; 'False' otherwise.   Bool-inRange r = go (fromEnum <$> r) . fromEnum+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+    rangeCheck (RangeObj b _ Nothing) = _forOrdering (b <=) (b ==) (b >=)+    rangeCheck (RangeObj b _ (Just e)) = _forOrdering (_rangeCheck b e) (b ==) (_rangeCheck e b)+    go r@(RangeObj _ Nothing _) = rangeCheck r LT+    go r@(RangeObj b (Just t) e)+      | b == t, _incCheck b e = rangeCheck r (rangeDirection r)+      | b == t = const False+      | otherwise = _both (rangeCheck r (rangeDirection r)) (_modCheck b t) +-- | Flipped alias of 'inRange' that checks if an element is in range of a given 'RangeObj'.+(∈) ::+  Enum a =>+  -- | The given element to check membership for.+  a ->+  -- | The 'RangeObj' object for which we check membership.+  RangeObj a ->+  -- | 'True' if the given element is an element of the given 'RangeObj' object; 'False' otherwise.+  Bool+(∈) = flip inRange++-- | Alias of 'inRange' that checks if an element is in range of a given 'RangeObj'.+(∋) ::+  Enum a =>+  -- | The 'RangeObj' object for which we check membership.+  RangeObj a ->+  -- | The given element to check membership for.+  a ->+  -- | 'True' if the given element is an element of the given 'RangeObj' object; 'False' otherwise.+  Bool+(∋) = inRange+ _both :: (a -> Bool) -> (a -> Bool) -> a -> Bool _both f g x = f x && g x @@ -321,3 +447,11 @@ rangepat = QuasiQuoter (parsefun id) (parsefun ((`ViewP` conP 'True []) . (VarE 'inRange `AppE`))) failQ failQ   where     parsefun pp = (liftFail >=> (pure . pp . rangeObjToExp . rangeToRangeObj)) . parseRange++-- | An alias of the 'rangepat' 'QuasiQuoter', this is used since it looks quite similar to @∊ [a .. b]@,+-- beware that the @ϵ@ in @[ϵ|a .. b|]@ is not an /element of/ character, but the /Greek lunate epsilon/ character+-- which only looks similar.+ϵ ::+  -- | The quasiquoter that can be used as expression and pattern.+  QuasiQuoter+ϵ = rangepat

@@ -1,11 +1,16 @@ {-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  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.Bool (bool)+import Data.Int (Int16, Int8)+import Data.Pattern.Any (RangeObj, inRange, rangeLastValue, rangeLength, rangeToList, rangepat, pattern FromRange, pattern FromThenRange, pattern FromThenToRange, pattern FromToRange)+import Data.Proxy (Proxy (Proxy)) import Data.Word (Word16, Word8) import Test.Hspec (describe, it) import Test.Hspec.Discover (Spec)@@ -18,15 +23,59 @@ allSame (FromThenToRange a b _) = a == b allSame _ = False +limitRangeList :: (Enum a, Eq a) => RangeObj a -> [a]+limitRangeList r = bool id (take 10) (allSame r) (rangeToList r)+ 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+testInRange r x = (x `elem` limitRangeList 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))+lastValueTest :: (Enum a, Eq a) => RangeObj a -> Bool+lastValueTest r+  | Just l <- rangeLastValue r = l == last (limitRangeList r)+  | otherwise = True +allInRange :: forall a. (Enum a, Eq a) => RangeObj a -> Bool+allInRange r = all (inRange r) (limitRangeList r)++rangepatFromCheck :: forall a. Enum a => a -> a -> Bool+rangepatFromCheck b x = f x == inRange (FromRange b) x+  where+    f [rangepat|b ..|] = True+    f _ = False++rangepatFromThenCheck :: forall a. Enum a => a -> a -> a -> Bool+rangepatFromThenCheck b s x = f x == inRange (FromThenRange b s) x+  where+    f [rangepat|b, s .. |] = True+    f _ = False++rangepatFromToCheck :: forall a. Enum a => a -> a -> a -> Bool+rangepatFromToCheck b e x = f x == inRange (FromToRange b e) x+  where+    f [rangepat|b .. e|] = True+    f _ = False++rangepatFromThenToCheck :: forall a. Enum a => a -> a -> a -> a -> Bool+rangepatFromThenToCheck b s e x = f x == inRange (FromThenToRange b s e) x+  where+    f [rangepat|b, s .. e|] = True+    f _ = False++rangepatCheck :: forall a. (Arbitrary a, Enum a, Show a) => Proxy a -> Spec+rangepatCheck _ = do+  it "from" (property (rangepatFromCheck @a))+  it "fromThen" (property (rangepatFromThenCheck @a))+  it "fromThenTo" (property (rangepatFromThenToCheck @a))+  it "fromTo" (property (rangepatFromToCheck @a))++rangeLengthCheck :: Enum a => RangeObj a -> Bool+rangeLengthCheck r+  | Just n <- rangeLength r = length (rangeToList r) == n+  | otherwise = True+ spec :: Spec spec = do   describe "range membership check" $ do@@ -41,3 +90,21 @@     it "Word8" (property (allInRange @Word8))     it "Word16" (property (allInRange @Word16))     it "Char" (property (allInRange @Char))+  describe "rangeLength" $ do+    it "Int8" (property (rangeLengthCheck @Int8))+    it "Int16" (property (rangeLengthCheck @Int16))+    it "Word8" (property (rangeLengthCheck @Word8))+    it "Word16" (property (rangeLengthCheck @Word16))+    it "Char" (property (rangeLengthCheck @Char))+  describe "rangeLastValue" $ do+    it "Int8" (property (lastValueTest @Int8))+    it "Int16" (property (lastValueTest @Int16))+    it "Word8" (property (lastValueTest @Word8))+    it "Word16" (property (lastValueTest @Word16))+    it "Char" (property (lastValueTest @Char))+  describe "range pattern checks" $ do+    describe "Int8" (rangepatCheck (Proxy :: Proxy Int8))+    describe "Int16" (rangepatCheck (Proxy :: Proxy Int16))+    describe "Word8" (rangepatCheck (Proxy :: Proxy Word8))+    describe "Word16" (rangepatCheck (Proxy :: Proxy Word16))+    describe "Char" (rangepatCheck (Proxy :: Proxy Char))