{- |
  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" }