{-# LANGUAGE FlexibleContexts #-}

module Language.Dickinson.Pattern ( matchPattern
                                  ) where

import           Control.Monad.Except     (MonadError, throwError)
import           Data.List.NonEmpty       as NE
import           Language.Dickinson.Error
import           Language.Dickinson.Type

-- incoherency warning: or-patterns with wildcards & vars?
matches :: Pattern a -> Expression a -> Bool
matches :: forall a. Pattern a -> Expression a -> Bool
matches Wildcard{} Expression a
_                           = Bool
True
matches (PatternCons a
_ TyName a
tn') (Constructor a
_ TyName a
tn) = TyName a
tn forall a. Eq a => a -> a -> Bool
== TyName a
tn'
matches PatternVar{} Expression a
_                         = Bool
True
matches (PatternTuple a
_ NonEmpty (Pattern a)
ps) (Tuple a
_ NonEmpty (Expression a)
es)       = forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith forall a. Pattern a -> Expression a -> Bool
matches NonEmpty (Pattern a)
ps NonEmpty (Expression a)
es) -- already check they're the same length during amalgamation
matches (OrPattern a
_ NonEmpty (Pattern a)
ps) Expression a
e                     = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Pattern a -> Expression a -> Bool
`matches` Expression a
e) NonEmpty (Pattern a)
ps
matches Pattern a
_ Expression a
_                                    = Bool
False

-- | Given an expression, find the first pattern it matches, failing if it
-- matches nothing.
matchPattern :: MonadError (DickinsonError a) m => a -> Expression a -> [(Pattern a, Expression a)] -> m (Pattern a, Expression a)
matchPattern :: forall a (m :: * -> *).
MonadError (DickinsonError a) m =>
a
-> Expression a
-> [(Pattern a, Expression a)]
-> m (Pattern a, Expression a)
matchPattern a
l Expression a
e ((Pattern a, Expression a)
p:[(Pattern a, Expression a)]
ps) | forall a. Pattern a -> Expression a -> Bool
matches (forall a b. (a, b) -> a
fst (Pattern a, Expression a)
p) Expression a
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern a, Expression a)
p
                        | Bool
otherwise = forall a (m :: * -> *).
MonadError (DickinsonError a) m =>
a
-> Expression a
-> [(Pattern a, Expression a)]
-> m (Pattern a, Expression a)
matchPattern a
l Expression a
e [(Pattern a, Expression a)]
ps
matchPattern a
l Expression a
e [] = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall a. a -> Expression a -> DickinsonError a
PatternFail a
l Expression a
e