any-pat (empty) → 0.1.0.0
raw patch · 6 files changed
+403/−0 lines, 6 filesdep +basedep +haskell-src-extsdep +haskell-src-metasetup-changed
Dependencies added: base, haskell-src-exts, haskell-src-meta, template-haskell
Files
- CHANGELOG.md +22/−0
- LICENSE +30/−0
- README.md +95/−0
- Setup.hs +2/−0
- any-pat.cabal +37/−0
- src/Data/Pattern/Any.hs +217/−0
+ CHANGELOG.md view
@@ -0,0 +1,22 @@+# Changelog for `any-pat`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+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+++>>>>>>> 130aa316ac71a5c5b58b0955bd6dc104977443f3
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Willem Van Onsem (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Willem Van Onsem nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,95 @@+# any-pat+[](https://github.com/hapytex/any-pat/actions/workflows/build-ci.yml)+[](https://hackage.haskell.org/package/any-pat)++Combine multiple patterns in a single pattern.++## 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:++```+mightBe :: (Int, a, a) -> Maybe a+mightBe (0, a, _) = Just a+mightBe (1, _, a) = Just a+mightBe _ = Nothing+```++the first two clauses have some repetitive elements. We can combine the two through the `anypat` or `maypat` quasiquoter:++```+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ViewPatterns #-}++mightBe :: (Int, a, a) -> Maybe a+mightBe [anypat|(0, a, _), (1, _, a)|] = Just a+mightBe _ = Nothing+```++or with `maypat`:++```+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ViewPatterns #-}++mightBe :: (Int, a, a) -> Maybe a+mightBe [maypat|(0, a _), (1, _, a), _|] = a+```++and that's it. No, there is no need to wrap `a` in a `Just` in the last code example.++We can also use the `maypat` and `anypat` to generate expressions, with:++```+{-# LANGUAGE QuasiQuotes #-}++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.++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.++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 = [maypat|(a:_), _|]+```++## 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>, …, p<sub>n</sub>|]</code>, it will create a view pattern that looks like:++<pre><code>\case+ p<sub>1</sub> -> Just n⃗+ p<sub>2</sub> -> Just n⃗+ ⋮+ p<sub>n</sub> -> Just n⃗+ _ -> Nothing</code></pre>++with <code>n⃗</code> the (sorted) tuple of names found in the patterns. It then makes a view pattern <code>e -> n⃗</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.++## `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.++## Contribute++You can contribute by making a pull request on the [*GitHub+repository*](https://github.com/hapytex/any-pat).++You can contact the package maintainer by sending a mail to+[`hapytexeu+gh@gmail.com`](mailto:hapytexeu+gh@gmail.com).+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ any-pat.cabal view
@@ -0,0 +1,37 @@+name: any-pat+version: 0.1.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+license: BSD3+license-file: LICENSE+author: Willem Van Onsem+maintainer: hapytexeu+gh@gmail.com+copyright: 2023 HaPyTeΧ+category: utils+build-type: Simple+extra-source-files: README.md+ CHANGELOG.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules:+ Data.Pattern.Any+ build-depends:+ base >= 4.7 && < 5+ , template-haskell >= 2.2.0.0+ , haskell-src-exts+ , haskell-src-meta+ default-language: Haskell2010+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-home-modules+ -Wredundant-constraints++source-repository head+ type: git+ location: https://github.com/hapytex/any-pat
+ src/Data/Pattern/Any.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Data.Pattern.Any+-- Description : A module to work with a 'QuasiQuoter' to use different patterns in the head same function clause.+-- Maintainer : hapytexeu+gh@gmail.com+-- Stability : experimental+-- Portability : POSIX+--+-- The module exposes two 'QuasiQuoter's named 'anypat' and 'maypat' that allow compiling separate patterns into a single (view) pattern that+-- will fire in case any of the patterns matches. If there are any variable names, it will match these. For the 'anypat' it requires that all+-- variables occur in all patterns. For 'maypat' that is not a requirement. For both 'QuasiQuoter's, it is however required that the variables+-- have the same type in each pattern.+module Data.Pattern.Any+ ( -- * Quasiquoters+ anypat,+ maypat,++ -- * derive variable names names from patterns+ patVars,+ patVars',+ )+where++import Control.Arrow (first)+import Control.Monad ((>=>))+# if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+#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.TH.Quote (QuasiQuoter (QuasiQuoter))++data HowPass = Simple | AsJust | AsNothing deriving (Eq, Ord, Read, Show)++-- | 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.+ Pat ->+ -- | The list of remaining elements that is added as tail.+ [Name] ->+ -- | The list of variable names that is used to collect (fragments) of the pattern.+ [Name]+patVars' (LitP _) = id+patVars' (VarP n) = (n :)+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' (ParensP p) = patVars' p+patVars' (TildeP p) = patVars' p+patVars' (BangP p) = patVars' p+patVars' (AsP n p) = (n :) . patVars' p+patVars' WildP = id+patVars' (RecP _ ps) = patVarsF (map snd ps)+patVars' (ListP ps) = patVarsF ps+patVars' (SigP p _) = patVars' p+patVars' (ViewP _ p) = patVars' p+patVars' x = patVarsExtra' x++#if MIN_VERSION_template_haskell(2,18,0)+patVarsExtra' :: Pat -> [Name] -> [Name]+patVarsExtra' (ConP _ _ ps) = patVarsF ps+patVarsExtra' _ = id+#else+patVarsExtra' :: Pat -> [Name] -> [Name]+patVarsExtra' (ConP _ ps) = patVarsF ps+patVarsExtra' _ = id+#endif++patVarsF :: [Pat] -> [Name] -> [Name]+patVarsF = foldr ((.) . patVars') id++-- | 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.+ Pat ->+ -- | The list of variable names that is used to collect (fragments) of the pattern.+ [Name]+patVars = (`patVars'` [])++howPass :: Bool -> Bool -> HowPass+howPass False True = AsJust+howPass False False = AsNothing+howPass True True = Simple+howPass True False = error "This should never happen"++unionPats :: NonEmpty Pat -> ([(Bool, Name)], [[(HowPass, Name)]])+unionPats (x :| xs) = (un, un')+ where+ n0 = go x+ ns = map go xs+ go = sort . patVars+ go' = map (True,)+ un = foldr (sortedUnion False False (&&) . go') (go' n0) ns+ un' = map (sortedUnion False False howPass un . map (True,)) (n0 : ns)++#if MIN_VERSION_template_haskell(2,18,0)+conP :: Name -> [Pat] -> Pat+conP = (`ConP` [])+#else+conP :: Name -> [Pat] -> Pat+conP = ConP+#endif++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))))++transName' :: HowPass -> Name -> Exp+transName' Simple = VarE+transName' AsNothing = const (ConE 'Nothing)+transName' AsJust = AppE (ConE 'Just) . VarE++transName :: (HowPass, Name) -> Exp+transName = uncurry transName'++#if MIN_VERSION_template_haskell(2, 16, 0)+_transName :: (HowPass, Name) -> Maybe Exp+_transName = Just . transName+#else+_transName :: (HowPass, Name) -> Exp+_transName = transName+#endif++wrapIt :: (a -> a) -> Bool -> a -> a+wrapIt f = go+ where+ go False = id+ go True = f++bodyExp :: Bool -> [(HowPass, Name)] -> Exp+bodyExp _ [] = ConE 'True+bodyExp b [n] = wrapIt (ConE 'Just `AppE`) b (transName n)+bodyExp b ns = wrapIt (ConE 'Just `AppE`) b (TupE (map _transName ns))++unionCaseFunc' :: [Pat] -> [Name] -> [[(HowPass, Name)]] -> (Exp, Pat)+unionCaseFunc' ps ns ns' = (LamCaseE (zipWith (\p' n -> Match p' (NormalB (bodyExp partial n)) []) ps ns' ++ add), p)+ where+ ~(ef, p) = bodyPat partial ns+ partial = WildP `notElem` ps+ add = [Match WildP (NormalB ef) [] | partial]++sortedUnion :: Ord a => b -> c -> (b -> c -> d) -> [(b, a)] -> [(c, a)] -> [(d, a)]+sortedUnion v0 v1 f = go+ where+ go [] ys = map (first (f v0)) ys+ go xa@((b0, x) : xs) ya@((b1, y) : ys) = case compare x y of+ EQ -> (f b0 b1, x) : go xs ys+ GT -> (f v0 b1, y) : go xa ys+ LT -> (f b0 v1, x) : go xs ya+ go xs [] = map (first (`f` v1)) xs++unionCaseFuncWith :: MonadFail m => ((Exp, Pat) -> a) -> Bool -> NonEmpty Pat -> m a+unionCaseFuncWith f chk ps@(p0 :| ps')+ | not chk || all fst ns = pure (f (unionCaseFunc' (p0 : ps') (map snd ns) ns'))+ | otherwise = fail "Not all patterns have the same variable names"+ where+ (ns, ns') = unionPats ps++unionCaseFunc :: MonadFail m => Bool -> NonEmpty Pat -> m Pat+unionCaseFunc = unionCaseFuncWith (uncurry ViewP)++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++#endif++liftFail :: MonadFail m => ParseResult a -> m a+liftFail (ParseOk x) = pure x+liftFail (ParseFailed _ s) = fail s++failQ :: a -> Q b+failQ = const (fail "The QuasiQuoter can only work to generate code as pattern.")++-- | 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.+ QuasiQuoter+anypat = QuasiQuoter ((liftFail >=> unionCaseExp True) . parsePatternSequence) ((liftFail >=> unionCaseFunc True) . parsePatternSequence) failQ failQ++-- | A quasiquoter to specify multiple patterns that will succeed if any of these patterns match. Patterns don't have to have the same variable names but if a variable is shared over the+-- 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.+ QuasiQuoter+maypat = QuasiQuoter ((liftFail >=> unionCaseExp False) . parsePatternSequence) ((liftFail >=> unionCaseFunc False) . parsePatternSequence) failQ failQ