Match.hs

{-|
Module      : Prosidy.Compile.Match
Description : Fallible pattern rules.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DerivingVia #-}
module Prosidy.Compile.Match
    ( -- * DSL for matching cases
      Match
    , MatchM
    , match
    -- ** Specific matchers
    , break
    , breakWith
    , paragraph
    , text

    -- *** Tag matchers which strictly enforce metadata.
    , blockTag
    , inlineTag
    , literalTag

    -- *** Tag matchers which loosely enforce metadata.
    , blockTag'
    , inlineTag'
    , literalTag'
    )
where

import           Prelude                 hiding ( break )
import           Prosidy.Compile.Core
import           Prosidy.Compile.Error
import           Prosidy.Compile.Strict

import           Control.Monad.State            ( StateT(..)
                                                , State
                                                , modify'
                                                , execState
                                                )
import           Data.Monoid                    ( Endo(..) )
import           Data.Text                      ( Text )
import           Data.List.NonEmpty             ( NonEmpty(..) )

import qualified Prosidy                       as P

-- | The type of fallible pattern specifications.
type Match i e f a = MatchM i e a f ()

-- | A monadic interface for defining fallible patterns. In practice, @r@ will
-- always be instantiated to @()@— 'Match' can be more clear.
newtype MatchM i e a f r = MatchM (State (Endo [Pattern i e f a]) r)
  deriving (Functor, Applicative, Monad)
    via State (Endo [Pattern i e f a])

-- | Finalize a 'Match' into a rule. This is often used to offset a match
-- block:
--
-- @
-- blocktags :: Match Block Void Identity String
-- blocktags = match $ do
--    ...
-- @
match :: (Applicative f, CanMatch i) => Match i e f a -> RuleT i e f a
match (MatchM s) = case appEndo (execState s mempty) [] of
    x : xs -> rule . TestMatch $ x :| xs
    []     -> rule $ Fail EmptyMatch

-- | Match against a 'Prosidy.Typs.Break'.
break :: RuleT () e f a -> Match P.Inline e f a
break = put . BreakP

-- | Replace all 'Prosidy.Types.Break's with the provided value.
breakWith :: a -> Match P.Inline e f a
breakWith = put . BreakP . pure

-- | Match 'Prosidy.Types.Paragraph's in a block context.
paragraph :: RuleT (P.SeriesNE P.Inline) e f a -> Match P.Block e f a
paragraph = put . ParagraphP

-- | Match plain 'Text' in an inline context.
text :: RuleT Text e f a -> Match P.Inline e f a
text = put . TextP

put :: Pattern i e f a -> Match i e f a
put x = MatchM $ modify' (<> Endo (x :))


-------------------------------------------------------------------------------
-- | Strict: match a 'Prosidy.Types.BlockTag' with the given 'P.Key'.
blockTag
    :: Applicative f => P.Key -> RuleT BlockRegion e f a -> Match P.Block e f a
blockTag key = put . BlockTagP key . strict

-- | Strict: match an 'Prosidy.Types.InlineTag' with the given 'P.Key'.
inlineTag
    :: Applicative f
    => P.Key
    -> RuleT InlineRegion e f a
    -> Match P.Inline e f a
inlineTag key = put . InlineTagP key . strict

-- | Strict: match an 'Prosidy.Types.LiteralTag' with the given 'P.Key'.
literalTag
    :: Applicative f
    => P.Key
    -> RuleT LiteralRegion e f a
    -> Match P.Block e f a
literalTag key = put . LitTagP key . strict

-------------------------------------------------------------------------------
-- | Lax: match a 'Prosidy.Types.BlockTag' with the given 'P.Key'.
blockTag' :: P.Key -> RuleT BlockRegion e f a -> Match P.Block e f a
blockTag' key = put . BlockTagP key

-- | Lax: match an 'Prosidy.Types.InlineTag' with the given 'P.Key'.
inlineTag' :: P.Key -> RuleT InlineRegion e f a -> Match P.Inline e f a
inlineTag' key = put . InlineTagP key

-- | Lax: match an 'Prosidy.Types.LiteralTag' with the given 'P.Key'.
literalTag' :: P.Key -> RuleT LiteralRegion e f a -> Match P.Block e f a
literalTag' key = put . LitTagP key