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
    , blocktag
    , inlinetag
    , literaltag
    , paragraph
    , text
    )
where

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

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 :: 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 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

-- | 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

-- | 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

-- | 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 :))