OrPatterns (empty) → 0.1
raw patch · 5 files changed
+273/−0 lines, 5 filesdep +basedep +containersdep +haskell-src-extssetup-changed
Dependencies added: base, containers, haskell-src-exts, haskell-src-meta, mtl, split, syb, template-haskell
Files
- LICENSE +30/−0
- OrPatterns.cabal +61/−0
- OrPatterns.hs +82/−0
- OrPatterns/Internal.hs +98/−0
- Setup.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Adam Vogt <vogt.adam@gmail.com>++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 Adam Vogt <vogt.adam@gmail.com> 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.
+ OrPatterns.cabal view
@@ -0,0 +1,61 @@+name: OrPatterns+version: 0.1+synopsis: A quasiquoter for or-patterns+description: A quasiquoter for or-patterns. It allows one additional+ form for patterns:+ .+ > f [o| p1 | p2 | p3 |] = rhs+ .+ Above, @p1@, @p2@ and @p3@ are three arbitrary patterns+ that bind the same variables. These variables are+ available in the expression @rhs@. Nesting of or-patterns+ is not supported yet.+ .+ See also:+ .+ * http://hackage.haskell.org/package/first-class-patterns+ supports @\\\/@ (or). However, variables bound with+ those patterns are not named. This means:+ .+ > g :: Either (x, y) (y, x) -> (x, y)+ > g [o| Left (x,y) | Right (y,x) |] = (x,y)+ .+ > -- ends up slightly longer+ > g = elim $ left (pair var var) \/ right flipped ->> (,)+ > where+ > flipped = (\(a,b) -> (b,a)) --> pair var var+ .+ * http://hackage.haskell.org/trac/ghc/ticket/3919+ is the feature request for or-patterns in ghc++license: BSD3+license-file: LICENSE+author: Adam Vogt <vogt.adam@gmail.com>+maintainer: Adam Vogt <vogt.adam@gmail.com>+category: Development+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.8.2,+ GHC == 7.6.2,+ GHC == 7.4.1++source-repository head+ type: darcs+ location: http://code.haskell.org/~aavogt/OrPatterns+++library+ exposed-modules: OrPatterns+ OrPatterns.Internal+ other-extensions: TemplateHaskell++ build-depends: base >=4.5 && <4.8,+ template-haskell >=2.4 && <2.10,+ mtl >=2.1 && <2.2,+ syb >=0.4 && <0.5,+ split >=0.2 && <0.3,+ haskell-src-meta >=0.6 && <0.7,+ haskell-src-exts >=1.15 && <1.16,+ containers >=0.3 && <0.6++ default-language: Haskell2010
+ OrPatterns.hs view
@@ -0,0 +1,82 @@+{- |+ Module : OrPatterns+ Copyright : (c) Adam Vogt 2011 - 2014+ License : BSD3+ Maintainer : Adam Vogt <vogt.adam@gmail.com>+ Stability : experimental+ Portability : GHC>=7 -XTemplateHaskell, -XViewPatterns+++Quasiquoter for /or patterns/ separated by @\" | \"@, like other languages+(ML family).+++Example:+++>>> :set -XQuasiQuotes -XViewPatterns -w+++>>> :{+>>> let f :: Either (a,b) (b,a) -> (a,b)+>>> f [o| Left (x,y) | Right (y,x) |] = (x,y)+>>> :}+++>>> map f [Left ('a',0), Right (2, 'b')]+[('a',0),('b',2)]+++A more confusing example (to show that the string " | " is interpreted+correctly by the parser):++>>> :{+>>> let g [o| " | " | "|||" | " | " |] = True+>>> g _ = False+>>> :}++>>> map g [ "|", " | " , "|||" , " | "]+[False,True,True,True]+++f is desugared to something like:++> f ( (\v -> case v of+> Left (x,y) -> Just (x,y)+> Right (y,x) -> Just (x,y)+> _ -> Nothing+> ) -> Just (x,y) ) = (x,y)++So failing to match will pass on to the next equation.++Limitations include:++* compilation could probably be more efficient++* incorrect patterns, such as those binding the wrong variables or the wrong+ number of variables could be reported better++* generated code can have overlapped patterns, and so -Wall doesn't help the+ above example. Duplicating or using ghc's check for this should be done,+ in which case the the desugared code should look like /f2/.++> f2 ( (\v -> case v of+> Left (x,y) -> (x,y)+> Right (y,x) -> (x,y))+> -> a) = a+++-}++module OrPatterns ( o ) where++import Language.Haskell.TH.Quote+import OrPatterns.Internal+++-- | or pattern quasiquote. See above.+o :: QuasiQuoter+o = QuasiQuoter { quotePat = either fail id . pats,+ quoteExp = error "OrPatterns.quoteExp",+ quoteType = error "OrPatterns.quoteType",+ quoteDec = error "OrPatterns.quoteDec" }
+ OrPatterns/Internal.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE TemplateHaskell #-}++{- |+ Module : OrPatterns.Internal+ Copyright : (c) Adam Vogt 2011 - 2014+ License : BSD3+ Maintainer : Adam Vogt <vogt.adam@gmail.com>+ Stability : experimental+ Portability : GHC>=7 -XTemplateHaskell, -XViewPatterns, syb++-}++module OrPatterns.Internal (+ pats,+ tryParseSplits,+ combineSplits,+ ) where++import Control.Monad.Error+import Data.Generics+import Data.List.Split+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Language.Haskell.Meta.Syntax.Translate (ToPat(toPat))+import qualified Language.Haskell.Exts as E+import qualified Data.Map as M+import Data.List++-- | parser used in 'OrPatterns.o'+pats :: String -> Either String PatQ+pats str = combineSplits =<< tryParseSplits sep parsePatAllExts (splitOn sep str)+ where sep = " | "++tryParseSplits :: [s] -> ([s] -> Either e r) -> [[s]] -> Either e [r]+tryParseSplits filler parsePat pieces = + let go accum (a:b:bs) = case parsePat a of+ Left {} -> go accum ((a ++ filler ++ b) : bs)+ Right x -> go (x:accum) (b:bs)+ go accum [a] = case parsePat a of+ Left msg -> Left msg+ Right x -> Right (reverse (x : accum))+ go accum [] = Right (reverse accum)+ in go [] pieces++combineSplits :: [Pat] -> Either String PatQ+combineSplits opts = do+ let counts = map+ (everything+ (M.unionWith (+))+ (mkQ M.empty (\x -> case x of+ VarP n -> M.singleton n 1+ _ -> M.empty))+ )+ opts+ -- assume that patterns may not repeat names of variables+ unless (all (== length counts) $ M.elems $ M.unionsWith (+) counts)+ (fail "Equations do not bind equal variables")++ let vars = M.keys (head counts)+ dest = [| Just $(tupE (map varE vars)) |]+ destP = conP 'Just [ tupP (map varP vars) ]++ return $ viewP+ [| \x -> $(caseE [| x |] $+ [ match (return p) (normalB dest) [] | p <- opts]+ ++ [match wildP (normalB [| Nothing |]) []]+ )+ |]+ destP+++parsePatAllExts :: String -> Either String Pat+parsePatAllExts str = toEither $ E.parsePatWithMode allExtensionsMode str++toEither :: (ToPat a, Show a) => E.ParseResult a -> Either String Pat+toEither (E.ParseOk x) = Right (toPat x)+toEither err = Left (show err)++allExtensionsMode :: E.ParseMode+allExtensionsMode =+ E.defaultParseMode{+ E.fixities = Nothing, -- these get filled in later+ E.extensions = map E.EnableExtension [+ E.ImplicitParams,+ E.BangPatterns,+ E.NamedFieldPuns,+ E.PatternGuards,+ E.TypeFamilies,+ E.UnicodeSyntax,+ E.TypeOperators,+ E.RecordWildCards,+ E.LambdaCase,+ E.ViewPatterns,+ E.TupleSections,+ E.NPlusKPatterns,+ E.DataKinds,+ E.PolyKinds,+ E.MultiWayIf ]}
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain