-----------------------------------------------------------------------------
-- |
-- Module:      Data.Pattern.Pattern
-- License:     BSD3
-- Maintainer:  Reiner Pope <reiner.pope@gmail.com>
-- Stability:   experimental
-- Portability: portable
--
-- The main types used.
-----------------------------------------------------------------------------


module Data.Pattern.Base (
  -- * Patterns
  Pattern(..),
  -- | Pattern synonyms. A @PatN@ is a function which takes @N@
  -- subpatterns and yields a 'Pattern' which binds all of the
  -- subpatterns' variables in order.
  Pat0, Pat1, Pat2, Pat3, Pat4, Pat5,
  -- * Clauses
  Clause,
  (->>), (|||), tryMatch, match,
  module Data.Pattern.Base.TypeList,
  module Data.Pattern.Base.Tuple,
 ) where

import Data.Pattern.Base.TypeList
import Data.Pattern.Base.Tuple

import Data.Maybe

import Control.Applicative
import Control.Monad


-- | The pattern type. A @Pattern vars a@ is a pattern which matches
-- against @a@s and binds variables with types given by the type-list
-- @vars@. 
-- 
-- Although this is the basic type used by patterns, many of
-- pattern combinators (for instance, 'Data.Pattern.Base.Common.left')
-- have types better expressed by the type synonyms 'Pat0', 'Pat1',
-- 'Pat2', etc, 'Pat5', so that nesting of patterns (e.g. @left (tup2
-- var var)@) can be written as function application. 
--
-- Most \"normal\" pattern matchers (in fact, all of the matchers in
-- "Data.Pattern.Common" except @var@ and @(\/)@) can be conveniently
-- defined using @mk0@, @mk1@, etc, @mk5@.
newtype Pattern vars a = Pattern { runPattern :: a -> Maybe (Tuple vars) }

type Pat0 a = Pattern Nil a
type Pat1 b a = forall bs. Pattern bs b -> Pattern bs a
type Pat2 b c a = forall bs cs. Pattern bs b -> Pattern cs c -> Pattern (bs :++: cs) a
type Pat3 b c d a = forall bs cs ds. Pattern bs b -> Pattern cs c -> Pattern ds d -> Pattern (bs :++: cs :++: ds) a
type Pat4 b c d e a = forall bs cs ds es. Pattern bs b -> Pattern cs c -> Pattern ds d -> Pattern es e -> Pattern (bs :++: cs :++: ds :++: es) a
type Pat5 b c d e f a = forall bs cs ds es fs. Pattern bs b -> Pattern cs c -> Pattern ds d -> Pattern es e -> Pattern fs f -> Pattern (bs :++: cs :++: ds :++: es :++: fs) a


-- | Pattern-match clauses. Typically something of the form 
--
-- @pattern '->>' function@
--
-- Three primitives on them are exposed: @('->>')@, @('|||')@,
-- and 'tryMatch', plus one convenience function: 'match'.
newtype Clause a r = Clause { runClause :: a -> Maybe r }

infix 2 ->>
infixr 1 |||

-- | Constructs a 'Clause'.
(->>) :: Pattern vars a -> Fun vars r -> Clause a r
(Pattern p) ->> k = Clause (\a -> fmap (\f -> runTuple f k) (p a))

-- | Alternative clauses: @p ||| q@ is the clause which first
-- attempts @p@, and then @q@ if @p@ fails.
(|||) :: Clause a r -> Clause a r -> Clause a r
l ||| r = Clause (\a -> runClause l a `mplus` runClause r a)

-- | \"Runs\" a 'Clause'.
tryMatch :: a -> Clause a r -> Maybe r
tryMatch = flip runClause

-- | @match a c = fromJust (tryMatch a c)@
match :: a -> Clause a r -> r
match = (fmap.fmap) (maybe (error "match") id) tryMatch