-- |
--
-- Module:      Control.Egison.Match
-- Description: Pattern-matching expressions
-- Stability:   experimental
--
-- This module exposes many combinators to perform pattern matching in [miniEgison](https://hackage.haskell.org/package/mini-egison)-like way.

module Control.Egison.Match
  ( matchAll
  , matchAllSingle
  , match
  )
where

import           Control.Egison.Matcher         ( Matcher )
import           Control.Monad.Search           ( MonadSearch(..) )

{-# INLINE matchAll #-}
matchAll
  :: (Matcher m t, MonadSearch s)
  => ((m, t) -> s (m, t))
  -> t
  -> m
  -> [(m, t) -> s r]
  -> [r]
matchAll :: forall m t (s :: * -> *) r.
(Matcher m t, MonadSearch s) =>
((m, t) -> s (m, t)) -> t -> m -> [(m, t) -> s r] -> [r]
matchAll (m, t) -> s (m, t)
strategy t
target m
matcher =
  (((m, t) -> s r) -> [r]) -> [(m, t) -> s r] -> [r]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(m, t) -> s r
b -> s r -> [r]
forall a. s a -> [a]
forall (m :: * -> *) a. MonadSearch m => m a -> [a]
toList ((m, t) -> s (m, t)
strategy (m
matcher, t
target) s (m, t) -> ((m, t) -> s r) -> s r
forall a b. s a -> (a -> s b) -> s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m, t) -> s r
b))

{-# INLINE matchAllSingle #-}
matchAllSingle
  :: (Matcher m t, MonadSearch s)
  => ((m, t) -> s (m, t))
  -> t
  -> m
  -> ((m, t) -> s r)
  -> [r]
matchAllSingle :: forall m t (s :: * -> *) r.
(Matcher m t, MonadSearch s) =>
((m, t) -> s (m, t)) -> t -> m -> ((m, t) -> s r) -> [r]
matchAllSingle (m, t) -> s (m, t)
strategy t
target m
matcher (m, t) -> s r
b =
  s r -> [r]
forall a. s a -> [a]
forall (m :: * -> *) a. MonadSearch m => m a -> [a]
toList ((m, t) -> s (m, t)
strategy (m
matcher, t
target) s (m, t) -> ((m, t) -> s r) -> s r
forall a b. s a -> (a -> s b) -> s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m, t) -> s r
b)

{-# INLINE match #-}
match
  :: (Matcher m t, MonadSearch s)
  => ((m, t) -> s (m, t))
  -> t
  -> m
  -> [(m, t) -> s r]
  -> r
match :: forall m t (s :: * -> *) r.
(Matcher m t, MonadSearch s) =>
((m, t) -> s (m, t)) -> t -> m -> [(m, t) -> s r] -> r
match (m, t) -> s (m, t)
strategy t
target m
matcher [(m, t) -> s r]
bs = [r] -> r
forall a. HasCallStack => [a] -> a
head (((m, t) -> s (m, t)) -> t -> m -> [(m, t) -> s r] -> [r]
forall m t (s :: * -> *) r.
(Matcher m t, MonadSearch s) =>
((m, t) -> s (m, t)) -> t -> m -> [(m, t) -> s r] -> [r]
matchAll (m, t) -> s (m, t)
strategy t
target m
matcher [(m, t) -> s r]
bs)