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