{-|
Module      : Prosidy.Compile
Description : Compile Prosidy documents into other shapes
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Prosidy.Compile
    ( -- * Accessors
      escapeHatch
    , getContent
    , matchContent
    , optParse
    , prop
    , reqParse
    , traversing
    , self
    -- * Reëxports
    , RuleT
    , Rule
    , CanMatch
    , Error(..)
    , ErrorSet
    , module Prosidy.Compile.Match
    , module Prosidy.Compile.Run
    )
where

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

import           Data.Text                      ( Text )

import qualified Prosidy                       as P

-------------------------------------------------------------------------------
-- | Access the inner 'Prosidy.Types.Content' of a node.
getContent :: P.HasContent i => RuleT (P.Content i) e f a -> RuleT i e f a
getContent :: RuleT (Content i) e f a -> RuleT i e f a
getContent = RuleF i e f a -> RuleT i e f a
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f a -> RuleT i e f a)
-> (RuleT (Content i) e f a -> RuleF i e f a)
-> RuleT (Content i) e f a
-> RuleT i e f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleT (Content i) e f a -> RuleF i e f a
forall input error (context :: * -> *) output.
HasContent input =>
RuleT (Content input) error context output
-> RuleF input error context output
GetContent

-- | Traverse over each item in a node's 'P.Content' via fallible matches.
matchContent
    :: (Traversable t, P.HasContent i, t x ~ P.Content i, CanMatch x)
    => Match x e f a
    -> RuleT i e f (t a)
matchContent :: Match x e f a -> RuleT i e f (t a)
matchContent = RuleT (t x) e f (t a) -> RuleT i e f (t a)
forall i e (f :: * -> *) a.
HasContent i =>
RuleT (Content i) e f a -> RuleT i e f a
getContent (RuleT (t x) e f (t a) -> RuleT i e f (t a))
-> (Match x e f a -> RuleT (t x) e f (t a))
-> Match x e f a
-> RuleT i e f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleT x e f a -> RuleT (t x) e f (t a)
forall (t :: * -> *) i e (f :: * -> *) a.
Traversable t =>
RuleT i e f a -> RuleT (t i) e f (t a)
traversing (RuleT x e f a -> RuleT (t x) e f (t a))
-> (Match x e f a -> RuleT x e f a)
-> Match x e f a
-> RuleT (t x) e f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match x e f a -> RuleT x e f a
forall i e (f :: * -> *) a.
CanMatch i =>
Match i e f a -> RuleT i e f a
match

-- | Parse an optional setting from a node with attached 'P.Metadata'.
optParse
    :: P.HasMetadata i
    => P.Key
    -> (Text -> Either String a)
    -> RuleT i e f (Maybe a)
optParse :: Key -> (Text -> Either String a) -> RuleT i e f (Maybe a)
optParse key :: Key
key = RuleF i e f (Maybe a) -> RuleT i e f (Maybe a)
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f (Maybe a) -> RuleT i e f (Maybe a))
-> ((Text -> Either String a) -> RuleF i e f (Maybe a))
-> (Text -> Either String a)
-> RuleT i e f (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe a)
-> Key -> (Text -> Either String a) -> RuleF i e f (Maybe a)
forall input x output error (context :: * -> *).
HasMetadata input =>
(Maybe x -> output)
-> Key
-> (Text -> Either String x)
-> RuleF input error context output
GetSetting Maybe a -> Maybe a
forall a. a -> a
id Key
key

-- | Check if a property is set on a node with attached 'P.Metadata'.
prop :: P.HasMetadata i => P.Key -> RuleT i e f Bool
prop :: Key -> RuleT i e f Bool
prop = RuleF i e f Bool -> RuleT i e f Bool
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f Bool -> RuleT i e f Bool)
-> (Key -> RuleF i e f Bool) -> Key -> RuleT i e f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Key -> RuleF i e f Bool
forall input a error (context :: * -> *).
HasMetadata input =>
(Bool -> a) -> Key -> RuleF input error context a
GetProperty Bool -> Bool
forall a. a -> a
id

-- | Parse an required setting from a node with attached 'P.Metadata'.
reqParse
    :: P.HasMetadata i => P.Key -> (Text -> Either String a) -> RuleT i e f a
reqParse :: Key -> (Text -> Either String a) -> RuleT i e f a
reqParse key :: Key
key = RuleF i e f a -> RuleT i e f a
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f a -> RuleT i e f a)
-> ((Text -> Either String a) -> RuleF i e f a)
-> (Text -> Either String a)
-> RuleT i e f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> (Text -> Either String a) -> RuleF i e f a
forall input output error (context :: * -> *).
HasMetadata input =>
Key
-> (Text -> Either String output)
-> RuleF input error context output
GetRequiredSetting Key
key

-- | Lift a 'RuleT' so that it operates on a traversable structure.
traversing :: Traversable t => RuleT i e f a -> RuleT (t i) e f (t a)
traversing :: RuleT i e f a -> RuleT (t i) e f (t a)
traversing = RuleF (t i) e f (t a) -> RuleT (t i) e f (t a)
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF (t i) e f (t a) -> RuleT (t i) e f (t a))
-> (RuleT i e f a -> RuleF (t i) e f (t a))
-> RuleT i e f a
-> RuleT (t i) e f (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t i -> t i)
-> (t a -> t a) -> RuleT i e f a -> RuleF (t i) e f (t a)
forall (t :: * -> *) input i o output error (context :: * -> *).
Traversable t =>
(input -> t i)
-> (t o -> output)
-> RuleT i error context o
-> RuleF input error context output
Traverse t i -> t i
forall a. a -> a
id t a -> t a
forall a. a -> a
id

-- | Access the contents of a node.
self :: RuleT i e f i
self :: RuleT i e f i
self = RuleF i e f i -> RuleT i e f i
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f i -> RuleT i e f i) -> RuleF i e f i -> RuleT i e f i
forall a b. (a -> b) -> a -> b
$ (i -> i) -> RuleF i e f i
forall input output error (context :: * -> *).
(input -> output) -> RuleF input error context output
GetSelf i -> i
forall a. a -> a
id

-- | Do anything you want with a node. This should be used sparingly! The
-- actions you perform inside of this function are invisible to inspection.
escapeHatch :: (i -> f (Either (Error e) a)) -> RuleT i e f a
escapeHatch :: (i -> f (Either (Error e) a)) -> RuleT i e f a
escapeHatch = RuleF i e f a -> RuleT i e f a
forall i e (f :: * -> *) o. RuleF i e f o -> RuleT i e f o
rule (RuleF i e f a -> RuleT i e f a)
-> ((i -> f (Either (Error e) a)) -> RuleF i e f a)
-> (i -> f (Either (Error e) a))
-> RuleT i e f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> f (Either (Error e) a)) -> RuleF i e f a
forall input (context :: * -> *) error output.
(input -> context (Either (Error error) output))
-> RuleF input error context output
Lift