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