{-|
Module      : Prosidy.Compile.DSL
Description : An EDSL for declaring 'Prosidy.Compile.Core.Rules'.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE PatternSynonyms #-}
module Prosidy.Compile.DSL
    ( content
      -- * Series rules
    , (&>)
    , (&>>)
    , folded
    , folded1
    , collect
    , end
    , endWith
      -- * Metadata rules
    , prop
    , req
    , opt
    , lax
      -- * Matchers
    , Match
    , match
    , blockTag
    , inlineTag
    , literalTag
    , paragraph
    , text
    , breakWith
      -- * Get wild with actions
    , local
    , self
    , hoist
      -- * Convenience classes
    , FromSetting(..)
    , RegionLike
    )
where

import qualified Prosidy
import           Prosidy.Types.Series           ( pattern Empty
                                                , pattern (:<:)
                                                , pattern (:<<:)
                                                )
import           Prosidy.Compile.Core
import           Data.Monoid                    ( Alt(..) )
import           Text.Read                      ( readMaybe )
import           Type.Reflection                ( Typeable
                                                , typeRep
                                                )
import           Data.Text                      ( Text )
import qualified Data.Text                     as Text
import qualified Data.Text.Lazy                as Text.Lazy
import           Numeric.Natural                ( Natural )

infixr 3 &>
infixr 1 &>>

-------------------------------------------------------------------------------
-- | Access the inner content of the 'RegionLike' value @t@. 
content :: RegionLike t => Rules (Prosidy.Content t) f a -> Rules t f a
content :: Rules (Content t) f a -> Rules t f a
content = RuleFor t f a -> Rules t f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor t f a -> Rules t f a)
-> (Rules (Content t) f a -> RuleFor t f a)
-> Rules (Content t) f a
-> Rules t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionRule (Content t) f a -> RuleFor t f a
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule (RegionRule (Content t) f a -> RuleFor t f a)
-> (Rules (Content t) f a -> RegionRule (Content t) f a)
-> Rules (Content t) f a
-> RuleFor t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules (Content t) f a -> RegionRule (Content t) f a
forall t (f :: * -> *) a. Rules t f a -> RegionRule t f a
RegionRuleContent

-------------------------------------------------------------------------------
-- | Given a 'Prosidy.Series', perform the rule on the left hand side on the
-- first element of the 'Prosidy.Series', and the rule on the right hand side
-- on all items after the first.
--
-- This can be used to define rules which must be evaluated sequentially.
(&>)
    :: Rules t f a
    -> Rules (Prosidy.Series t) f (Prosidy.Series a)
    -> Rules (Prosidy.Series t) f (Prosidy.Series a)
r :: Rules t f a
r &> :: Rules t f a
-> Rules (Series t) f (Series a) -> Rules (Series t) f (Series a)
&> rs :: Rules (Series t) f (Series a)
rs = SeriesRule t f (Series a) -> Rules (Series t) f (Series a)
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (SeriesRule t f (Series a) -> Rules (Series t) f (Series a))
-> (SeriesNERule t f (Series a) -> SeriesRule t f (Series a))
-> SeriesNERule t f (Series a)
-> Rules (Series t) f (Series a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesNERule t f (Series a) -> SeriesRule t f (Series a)
forall t (f :: * -> *) a. SeriesNERule t f a -> SeriesRule t f a
SeriesRuleNext (SeriesNERule t f (Series a) -> Rules (Series t) f (Series a))
-> SeriesNERule t f (Series a) -> Rules (Series t) f (Series a)
forall a b. (a -> b) -> a -> b
$ (a -> Series a -> Series a)
-> Rules t f a
-> Rules (Series t) f (Series a)
-> SeriesNERule t f (Series a)
forall t (f :: * -> *) a b c.
(b -> c -> a)
-> Rules t f b -> Rules (Series t) f c -> SeriesNERule t f a
SeriesNERule a -> Series a -> Series a
forall a. a -> Series a -> Series a
(:<:) Rules t f a
r Rules (Series t) f (Series a)
rs

-- | Like '(&>)', but returns a combined rule which operates on a non-empty
-- series ('Prosidy.SeriesNE').
(&>>)
    :: Rules t f a
    -> Rules (Prosidy.Series t) f (Prosidy.Series a)
    -> Rules (Prosidy.SeriesNE t) f (Prosidy.SeriesNE a)
r :: Rules t f a
r &>> :: Rules t f a
-> Rules (Series t) f (Series a)
-> Rules (SeriesNE t) f (SeriesNE a)
&>> rs :: Rules (Series t) f (Series a)
rs = RuleFor (SeriesNE t) f (SeriesNE a)
-> Rules (SeriesNE t) f (SeriesNE a)
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor (SeriesNE t) f (SeriesNE a)
 -> Rules (SeriesNE t) f (SeriesNE a))
-> RuleFor (SeriesNE t) f (SeriesNE a)
-> Rules (SeriesNE t) f (SeriesNE a)
forall a b. (a -> b) -> a -> b
$ (a -> Series a -> SeriesNE a)
-> Rules t f a
-> Rules (Series t) f (Series a)
-> SeriesNERule t f (SeriesNE a)
forall t (f :: * -> *) a b c.
(b -> c -> a)
-> Rules t f b -> Rules (Series t) f c -> SeriesNERule t f a
SeriesNERule a -> Series a -> SeriesNE a
forall a. a -> Series a -> SeriesNE a
(:<<:) Rules t f a
r Rules (Series t) f (Series a)
rs

-- | Match the end of a 'Prosidy.Series'.
end :: Rules (Prosidy.Series t) f (Prosidy.Series a)
end :: Rules (Series t) f (Series a)
end = Series a -> Rules (Series t) f (Series a)
forall a t (f :: * -> *). a -> Rules (Series t) f a
endWith Series a
forall a. Series a
Empty

-- | Match the end of a 'Prosidy.Series', returning the provided value.
endWith :: a -> Rules (Prosidy.Series t) f a
endWith :: a -> Rules (Series t) f a
endWith = SeriesRule t f a -> Rules (Series t) f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (SeriesRule t f a -> Rules (Series t) f a)
-> (a -> SeriesRule t f a) -> a -> Rules (Series t) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SeriesRule t f a
forall t (f :: * -> *) a. a -> SeriesRule t f a
SeriesRuleEmpty

-- | Lift a rule to collect many of that rule in series
collect :: Rules t f a -> Rules (Prosidy.Series t) f (Prosidy.Series a)
collect :: Rules t f a -> Rules (Series t) f (Series a)
collect rules :: Rules t f a
rules = Rules (Series t) f (Series a)
go
  where
    go :: Rules (Series t) f (Series a)
go = (Rules t f a
rules Rules t f a
-> Rules (Series t) f (Series a) -> Rules (Series t) f (Series a)
forall t (f :: * -> *) a.
Rules t f a
-> Rules (Series t) f (Series a) -> Rules (Series t) f (Series a)
&> Rules (Series t) f (Series a)
go) Rules (Series t) f (Series a)
-> Rules (Series t) f (Series a) -> Rules (Series t) f (Series a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Rules (Series t) f (Series a)
forall t (f :: * -> *) a. Rules (Series t) f (Series a)
end

-- | Lift a rule to operate on a 'Prosidy.Series' by folding the results of
-- evaluation against each element into a single result.
folded :: Monoid a => Rules t f a -> Rules (Prosidy.Series t) f a
folded :: Rules t f a -> Rules (Series t) f a
folded r :: Rules t f a
r = Rules (Series t) f a
go
  where
    go :: Rules (Series t) f a
go = RuleFor (Series t) f a -> Rules (Series t) f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (SeriesNERule t f a -> RuleFor (Series t) f a
forall t (f :: * -> *) a. SeriesNERule t f a -> SeriesRule t f a
SeriesRuleNext (SeriesNERule t f a -> RuleFor (Series t) f a)
-> SeriesNERule t f a -> RuleFor (Series t) f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a)
-> Rules t f a -> Rules (Series t) f a -> SeriesNERule t f a
forall t (f :: * -> *) a b c.
(b -> c -> a)
-> Rules t f b -> Rules (Series t) f c -> SeriesNERule t f a
SeriesNERule a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Rules t f a
r Rules (Series t) f a
go)
        Rules (Series t) f a
-> Rules (Series t) f a -> Rules (Series t) f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RuleFor (Series t) f a -> Rules (Series t) f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (a -> SeriesRule t f a
forall t (f :: * -> *) a. a -> SeriesRule t f a
SeriesRuleEmpty a
forall a. Monoid a => a
mempty)

-- | Like 'folded', but operates on a non-empty series.    
folded1 :: Monoid a => Rules t f a -> Rules (Prosidy.SeriesNE t) f a
folded1 :: Rules t f a -> Rules (SeriesNE t) f a
folded1 r :: Rules t f a
r = RuleFor (SeriesNE t) f a -> Rules (SeriesNE t) f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor (SeriesNE t) f a -> Rules (SeriesNE t) f a)
-> RuleFor (SeriesNE t) f a -> Rules (SeriesNE t) f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a)
-> Rules t f a -> Rules (Series t) f a -> SeriesNERule t f a
forall t (f :: * -> *) a b c.
(b -> c -> a)
-> Rules t f b -> Rules (Series t) f c -> SeriesNERule t f a
SeriesNERule a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) Rules t f a
r (Rules t f a -> Rules (Series t) f a
forall a t (f :: * -> *).
Monoid a =>
Rules t f a -> Rules (Series t) f a
folded Rules t f a
r)

-------------------------------------------------------------------------------
-- | A class for recursive nodes in a document.
class Prosidy.HasContent t => RegionLike t where
    liftRegionRule :: RegionRule (Prosidy.Content t) f a -> RuleFor t f a

instance RegionLike Prosidy.Document where
    liftRegionRule :: RegionRule (Content Document) f a -> RuleFor Document f a
liftRegionRule = RegionRule (Content Document) f a -> RuleFor Document f a
forall (f :: * -> *) a.
RegionRule (Series Block) f a -> DocumentRule f a
DocumentRule

instance RegionLike (Prosidy.Tag t) where
    liftRegionRule :: RegionRule (Content (Tag t)) f a -> RuleFor (Tag t) f a
liftRegionRule = RegionRule (Content (Tag t)) f a -> RuleFor (Tag t) f a
forall t (f :: * -> *) a. RegionRule t f a -> TagRule t f a
TagRuleRegion

instance RegionLike (Prosidy.Region t) where
    liftRegionRule :: RegionRule (Content (Region t)) f a -> RuleFor (Region t) f a
liftRegionRule = RegionRule (Content (Region t)) f a -> RuleFor (Region t) f a
forall a. a -> a
id

-- | Check if a 'Prosidy.Metadata' property is set on a node.
prop :: RegionLike t => Prosidy.Key -> Rules t f Bool
prop :: Key -> Rules t f Bool
prop = RuleFor t f Bool -> Rules t f Bool
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor t f Bool -> Rules t f Bool)
-> (Key -> RuleFor t f Bool) -> Key -> Rules t f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionRule (Content t) f Bool -> RuleFor t f Bool
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule (RegionRule (Content t) f Bool -> RuleFor t f Bool)
-> (Key -> RegionRule (Content t) f Bool)
-> Key
-> RuleFor t f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataRule f Bool -> RegionRule (Content t) f Bool
forall t (f :: * -> *) a. MetadataRule f a -> RegionRule t f a
RegionRuleMetadata (MetadataRule f Bool -> RegionRule (Content t) f Bool)
-> (Key -> MetadataRule f Bool)
-> Key
-> RegionRule (Content t) f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Key -> MetadataRule f Bool
forall k (f :: k) a. (Bool -> a) -> Key -> MetadataRule f a
MetadataRuleProperty Bool -> Bool
forall a. a -> a
id

-- | Fetch a /required/ 'Prosidy.Metadata' value from a node, parsing it using
-- the provided function.
reqWith
    :: forall a t f. RegionLike t => (Text -> Either String a) -> Prosidy.Key -> Rules t f a
reqWith :: (Text -> Either String a) -> Key -> Rules t f a
reqWith parse :: Text -> Either String a
parse =
    RuleFor t f a -> Rules t f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule
        (RuleFor t f a -> Rules t f a)
-> (Key -> RuleFor t f a) -> Key -> Rules t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionRule (Content t) f a -> RuleFor t f a
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule
        (RegionRule (Content t) f a -> RuleFor t f a)
-> (Key -> RegionRule (Content t) f a) -> Key -> RuleFor t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataRule f a -> RegionRule (Content t) f a
forall t (f :: * -> *) a. MetadataRule f a -> RegionRule t f a
RegionRuleMetadata
        (MetadataRule f a -> RegionRule (Content t) f a)
-> (Key -> MetadataRule f a) -> Key -> RegionRule (Content t) f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String a) -> Maybe a -> Key -> MetadataRule f a
forall k (f :: k) a.
(Text -> Either String a) -> Maybe a -> Key -> MetadataRule f a
MetadataRuleSetting Text -> Either String a
parse Maybe a
forall a. Maybe a
Nothing

-- | Fetch a /required/ 'Prosidy.Metadata' setting from a node.
req :: forall a t f. (RegionLike t, FromSetting a) => Prosidy.Key -> Rules t f a
req :: Key -> Rules t f a
req = (Text -> Either String a) -> Key -> Rules t f a
forall a t (f :: * -> *).
RegionLike t =>
(Text -> Either String a) -> Key -> Rules t f a
reqWith Text -> Either String a
forall a. FromSetting a => Text -> Either String a
parseSetting

-- | Fetch an /optional/ 'Prosidy.Metadata' value from a node, parsing it using
-- the provided function.
optWith
    :: forall a t f. RegionLike t
    => (Text -> Either String a)
    -> Prosidy.Key
    -> Rules t f (Maybe a)
optWith :: (Text -> Either String a) -> Key -> Rules t f (Maybe a)
optWith parse :: Text -> Either String a
parse =
    RuleFor t f (Maybe a) -> Rules t f (Maybe a)
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor t f (Maybe a) -> Rules t f (Maybe a))
-> (Key -> RuleFor t f (Maybe a)) -> Key -> Rules t f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionRule (Content t) f (Maybe a) -> RuleFor t f (Maybe a)
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule (RegionRule (Content t) f (Maybe a) -> RuleFor t f (Maybe a))
-> (Key -> RegionRule (Content t) f (Maybe a))
-> Key
-> RuleFor t f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataRule f (Maybe a) -> RegionRule (Content t) f (Maybe a)
forall t (f :: * -> *) a. MetadataRule f a -> RegionRule t f a
RegionRuleMetadata (MetadataRule f (Maybe a) -> RegionRule (Content t) f (Maybe a))
-> (Key -> MetadataRule f (Maybe a))
-> Key
-> RegionRule (Content t) f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either String (Maybe a))
-> Maybe (Maybe a) -> Key -> MetadataRule f (Maybe a)
forall k (f :: k) a.
(Text -> Either String a) -> Maybe a -> Key -> MetadataRule f a
MetadataRuleSetting
        ((a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> (Text -> Either String a) -> Text -> Either String (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String a
parse)
        (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing)

-- | Fetch an /optional/ 'Prosidy.Metadata' setting from a node.
opt :: forall a t f. (RegionLike t, FromSetting a) => Prosidy.Key -> Rules t f (Maybe a)
opt :: Key -> Rules t f (Maybe a)
opt = (Text -> Either String a) -> Key -> Rules t f (Maybe a)
forall a t (f :: * -> *).
RegionLike t =>
(Text -> Either String a) -> Key -> Rules t f (Maybe a)
optWith Text -> Either String a
forall a. FromSetting a => Text -> Either String a
parseSetting

-- | Allow unknown properties and settings in this region.
lax :: RegionLike t => Rules t f ()
lax :: Rules t f ()
lax = RuleFor t f () -> Rules t f ()
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (RuleFor t f () -> Rules t f ())
-> (MetadataRule f () -> RuleFor t f ())
-> MetadataRule f ()
-> Rules t f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionRule (Content t) f () -> RuleFor t f ()
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule (RegionRule (Content t) f () -> RuleFor t f ())
-> (MetadataRule f () -> RegionRule (Content t) f ())
-> MetadataRule f ()
-> RuleFor t f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataRule f () -> RegionRule (Content t) f ()
forall t (f :: * -> *) a. MetadataRule f a -> RegionRule t f a
RegionRuleMetadata (MetadataRule f () -> Rules t f ())
-> MetadataRule f () -> Rules t f ()
forall a b. (a -> b) -> a -> b
$ () -> MetadataRule f ()
forall k (f :: k) a. a -> MetadataRule f a
MetadataRuleAllowUnknown ()

-------------------------------------------------------------------------------
-- | A class for values which can be parsed from 'Text'.
class FromSetting a where
    parseSetting :: Text -> Either String a

    default parseSetting :: (Typeable a, Read a) => Text -> Either String a
    parseSetting raw :: Text
raw = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
raw) of
        Just ok :: a
ok -> a -> Either String a
forall a b. b -> Either a b
Right a
ok
        Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ "Failed to parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
raw String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " as type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep a -> String
forall a. Show a => a -> String
show (Typeable a => TypeRep a
forall k (a :: k). Typeable a => TypeRep a
typeRep @a)

instance FromSetting Double
instance FromSetting Float
instance FromSetting Int
instance FromSetting Integer
instance FromSetting Natural
instance FromSetting Word

instance FromSetting String where
    parseSetting :: Text -> Either String String
parseSetting = String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String)
-> (Text -> String) -> Text -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

instance FromSetting Text where
    parseSetting :: Text -> Either String Text
parseSetting = Text -> Either String Text
forall a b. b -> Either a b
Right
    {-# INLINE parseSetting #-}

instance FromSetting Text.Lazy.Text where
    parseSetting :: Text -> Either String Text
parseSetting = Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text)
-> (Text -> Text) -> Text -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.Lazy.fromStrict
    {-# INLINE parseSetting #-}

-------------------------------------------------------------------------------
-- | A type used to declare alternatives in @do@ notation.
type Match t f a = MatchM t f a ()

data MatchM t f a r = MatchM !(Alt (Rules t f) a) !r

instance Semigroup r => Semigroup (MatchM t a f r) where
    MatchM r :: Alt (Rules t a) f
r a :: r
a <> :: MatchM t a f r -> MatchM t a f r -> MatchM t a f r
<> MatchM s :: Alt (Rules t a) f
s b :: r
b = Alt (Rules t a) f -> r -> MatchM t a f r
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM (Alt (Rules t a) f
r Alt (Rules t a) f -> Alt (Rules t a) f -> Alt (Rules t a) f
forall a. Semigroup a => a -> a -> a
<> Alt (Rules t a) f
s) (r
a r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
b)

instance Monoid r => Monoid (MatchM t a f r) where
    mempty :: MatchM t a f r
mempty = Alt (Rules t a) f -> r -> MatchM t a f r
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM Alt (Rules t a) f
forall a. Monoid a => a
mempty r
forall a. Monoid a => a
mempty

instance Functor (MatchM t f a) where
    fmap :: (a -> b) -> MatchM t f a a -> MatchM t f a b
fmap fn :: a -> b
fn (MatchM r :: Alt (Rules t f) a
r x :: a
x) = Alt (Rules t f) a -> b -> MatchM t f a b
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM Alt (Rules t f) a
r (a -> b
fn a
x)

instance Applicative (MatchM t f a) where
    pure :: a -> MatchM t f a a
pure = Alt (Rules t f) a -> a -> MatchM t f a a
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM Alt (Rules t f) a
forall a. Monoid a => a
mempty
    MatchM lhs :: Alt (Rules t f) a
lhs fn :: a -> b
fn <*> :: MatchM t f a (a -> b) -> MatchM t f a a -> MatchM t f a b
<*> MatchM rhs :: Alt (Rules t f) a
rhs x :: a
x = Alt (Rules t f) a -> b -> MatchM t f a b
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM (Alt (Rules t f) a
lhs Alt (Rules t f) a -> Alt (Rules t f) a -> Alt (Rules t f) a
forall a. Semigroup a => a -> a -> a
<> Alt (Rules t f) a
rhs) (a -> b
fn a
x)

instance Monad (MatchM t f a) where
    MatchM lhs :: Alt (Rules t f) a
lhs x :: a
x >>= :: MatchM t f a a -> (a -> MatchM t f a b) -> MatchM t f a b
>>= f :: a -> MatchM t f a b
f = let MatchM rhs :: Alt (Rules t f) a
rhs x' :: b
x' = a -> MatchM t f a b
f a
x in Alt (Rules t f) a -> b -> MatchM t f a b
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM (Alt (Rules t f) a
lhs Alt (Rules t f) a -> Alt (Rules t f) a -> Alt (Rules t f) a
forall a. Semigroup a => a -> a -> a
<> Alt (Rules t f) a
rhs) b
x'

-- | Lifts a 'Match' into 'Rules' by trying each defined pattern, from top to
-- bottom, until a match is found.
match :: Match t f a -> Rules t f a
match :: Match t f a -> Rules t f a
match (MatchM (Alt r :: Rules t f a
r) ()) = Rules t f a
r

-- | Match a 'Prosidy.BlockTag' with the proided 'Prosidy.Key'.
blockTag
    :: Functor f
    => Prosidy.Key
    -> Rules Prosidy.BlockRegion f a
    -> Match Prosidy.Block f a
blockTag :: Key -> Rules BlockRegion f a -> Match Block f a
blockTag key :: Key
key = BlockRule f a -> Match Block f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (BlockRule f a -> Match Block f a)
-> (Rules BlockRegion f a -> BlockRule f a)
-> Rules BlockRegion f a
-> Match Block f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules BlockTag f a -> BlockRule f a
forall (f :: * -> *) a. Rules BlockTag f a -> BlockRule f a
BlockRuleBlockTag (Rules BlockTag f a -> BlockRule f a)
-> (Rules BlockRegion f a -> Rules BlockTag f a)
-> Rules BlockRegion f a
-> BlockRule f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Rules BlockRegion f a -> Rules BlockTag f a
forall (f :: * -> *) t a.
Functor f =>
Key -> Rules (Region t) f a -> Rules (Tag t) f a
tagRule Key
key

-- | Match a 'Prosidy.LiteralTag' with the provided 'Prosidy.Key'.
literalTag
    :: Functor f
    => Prosidy.Key
    -> Rules Prosidy.LiteralRegion f a
    -> Match Prosidy.Block f a
literalTag :: Key -> Rules LiteralRegion f a -> Match Block f a
literalTag key :: Key
key = BlockRule f a -> Match Block f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (BlockRule f a -> Match Block f a)
-> (Rules LiteralRegion f a -> BlockRule f a)
-> Rules LiteralRegion f a
-> Match Block f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules LiteralTag f a -> BlockRule f a
forall (f :: * -> *) a. Rules LiteralTag f a -> BlockRule f a
BlockRuleLiteralTag (Rules LiteralTag f a -> BlockRule f a)
-> (Rules LiteralRegion f a -> Rules LiteralTag f a)
-> Rules LiteralRegion f a
-> BlockRule f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Rules LiteralRegion f a -> Rules LiteralTag f a
forall (f :: * -> *) t a.
Functor f =>
Key -> Rules (Region t) f a -> Rules (Tag t) f a
tagRule Key
key

-- | Match a 'Prosidy.InlineTag' with the provided 'Prosidy.Key'.
inlineTag
    :: Functor f
    => Prosidy.Key
    -> Rules Prosidy.InlineRegion f a
    -> Match Prosidy.Inline f a
inlineTag :: Key -> Rules InlineRegion f a -> Match Inline f a
inlineTag key :: Key
key = InlineRule f a -> Match Inline f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (InlineRule f a -> Match Inline f a)
-> (Rules InlineRegion f a -> InlineRule f a)
-> Rules InlineRegion f a
-> Match Inline f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules InlineTag f a -> InlineRule f a
forall (f :: * -> *) a. Rules InlineTag f a -> InlineRule f a
InlineRuleInlineTag (Rules InlineTag f a -> InlineRule f a)
-> (Rules InlineRegion f a -> Rules InlineTag f a)
-> Rules InlineRegion f a
-> InlineRule f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Rules InlineRegion f a -> Rules InlineTag f a
forall (f :: * -> *) t a.
Functor f =>
Key -> Rules (Region t) f a -> Rules (Tag t) f a
tagRule Key
key

-- | Match a paragraph which is not enclosed in a tag.
paragraph
    :: Rules (Prosidy.SeriesNE Prosidy.Inline) f a -> Match Prosidy.Block f a
paragraph :: Rules (SeriesNE Inline) f a -> Match Block f a
paragraph = BlockRule f a -> Match Block f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (BlockRule f a -> Match Block f a)
-> (Rules (SeriesNE Inline) f a -> BlockRule f a)
-> Rules (SeriesNE Inline) f a
-> Match Block f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules Paragraph f a -> BlockRule f a
forall (f :: * -> *) a. Rules Paragraph f a -> BlockRule f a
BlockRuleParagraph (Rules Paragraph f a -> BlockRule f a)
-> (Rules (SeriesNE Inline) f a -> Rules Paragraph f a)
-> Rules (SeriesNE Inline) f a
-> BlockRule f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParagraphRule f a -> Rules Paragraph f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (ParagraphRule f a -> Rules Paragraph f a)
-> (Rules (SeriesNE Inline) f a -> ParagraphRule f a)
-> Rules (SeriesNE Inline) f a
-> Rules Paragraph f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules (SeriesNE Inline) f a -> ParagraphRule f a
forall (f :: * -> *) a.
Rules (SeriesNE Inline) f a -> ParagraphRule f a
ParagraphRuleContent

-- | Match textual content, transforming it with the provided function.
text :: (Text -> a) -> Match Prosidy.Inline f a
text :: (Text -> a) -> Match Inline f a
text = InlineRule f a -> Match Inline f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (InlineRule f a -> Match Inline f a)
-> ((Text -> a) -> InlineRule f a)
-> (Text -> a)
-> Match Inline f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules Fragment f a -> InlineRule f a
forall (f :: * -> *) a. Rules Fragment f a -> InlineRule f a
InlineRuleFragment (Rules Fragment f a -> InlineRule f a)
-> ((Text -> a) -> Rules Fragment f a)
-> (Text -> a)
-> InlineRule f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FragmentRule f a -> Rules Fragment f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (FragmentRule f a -> Rules Fragment f a)
-> ((Text -> a) -> FragmentRule f a)
-> (Text -> a)
-> Rules Fragment f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> a) -> FragmentRule f a
forall k (f :: k) a. (Text -> a) -> FragmentRule f a
FragmentRuleText

-- | Replace inline breaks with the provided vlaue.
breakWith :: a -> Match Prosidy.Inline f a
breakWith :: a -> Match Inline f a
breakWith = InlineRule f a -> Match Inline f a
forall t (f :: * -> *) a. RuleFor t f a -> Match t f a
matchRule (InlineRule f a -> Match Inline f a)
-> (a -> InlineRule f a) -> a -> Match Inline f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> InlineRule f a
forall (f :: * -> *) a. a -> InlineRule f a
InlineRuleBreak

matchRule :: RuleFor t f a -> Match t f a
matchRule :: RuleFor t f a -> Match t f a
matchRule = (Alt (Rules t f) a -> () -> Match t f a)
-> () -> Alt (Rules t f) a -> Match t f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Alt (Rules t f) a -> () -> Match t f a
forall t (f :: * -> *) a r.
Alt (Rules t f) a -> r -> MatchM t f a r
MatchM () (Alt (Rules t f) a -> Match t f a)
-> (RuleFor t f a -> Alt (Rules t f) a)
-> RuleFor t f a
-> Match t f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rules t f a -> Alt (Rules t f) a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (Rules t f a -> Alt (Rules t f) a)
-> (RuleFor t f a -> Rules t f a)
-> RuleFor t f a
-> Alt (Rules t f) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleFor t f a -> Rules t f a
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule

tagRule
    :: Functor f
    => Prosidy.Key
    -> Rules (Prosidy.Region t) f a
    -> Rules (Prosidy.Tag t) f a
tagRule :: Key -> Rules (Region t) f a -> Rules (Tag t) f a
tagRule key :: Key
key r :: Rules (Region t) f a
r =
    RuleFor (Tag t) f () -> Rules (Tag t) f ()
forall t (f :: * -> *) a. RuleFor t f a -> Rules t f a
rule (Key -> () -> TagRule t f ()
forall t (f :: * -> *) a. Key -> a -> TagRule t f a
TagRuleKey Key
key ()) Rules (Tag t) f () -> Rules (Tag t) f a -> Rules (Tag t) f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall x. RuleFor (Region t) f x -> RuleFor (Tag t) f x)
-> (Tag t -> Region t)
-> (a -> a)
-> Rules (Region t) f a
-> Rules (Tag t) f a
forall a a' t t' (f :: * -> *).
(Functor f, Functor (RuleFor t' f)) =>
(forall x. RuleFor t f x -> RuleFor t' f x)
-> (t' -> t) -> (a -> a') -> Rules t f a -> Rules t' f a'
mapRules forall x. RuleFor (Region t) f x -> RuleFor (Tag t) f x
forall t (f :: * -> *) a.
RegionLike t =>
RegionRule (Content t) f a -> RuleFor t f a
liftRegionRule Tag t -> Region t
forall a. Tag a -> Region a
Prosidy.tagToRegion a -> a
forall a. a -> a
id Rules (Region t) f a
r