{-# LANGUAGE DeriveFunctor #-}

module Language.Ltml.Common
    ( Flagged (..)
    , Flagged'
    , flagMap
    , ParseError
    , Parsed
    , NavTocHeaded (..)
    )
where

import Control.Functor.Utils (TraversableF (traverseF))
import Data.Text (Text)
import Data.Void (Void)
import Language.Lsd.AST.Common (NavTocHeading)
import Text.Megaparsec (ParseErrorBundle)

data Flagged flag a = Flagged flag a
    deriving ((forall a b. (a -> b) -> Flagged flag a -> Flagged flag b)
-> (forall a b. a -> Flagged flag b -> Flagged flag a)
-> Functor (Flagged flag)
forall a b. a -> Flagged flag b -> Flagged flag a
forall a b. (a -> b) -> Flagged flag a -> Flagged flag b
forall flag a b. a -> Flagged flag b -> Flagged flag a
forall flag a b. (a -> b) -> Flagged flag a -> Flagged flag b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall flag a b. (a -> b) -> Flagged flag a -> Flagged flag b
fmap :: forall a b. (a -> b) -> Flagged flag a -> Flagged flag b
$c<$ :: forall flag a b. a -> Flagged flag b -> Flagged flag a
<$ :: forall a b. a -> Flagged flag b -> Flagged flag a
Functor, Int -> Flagged flag a -> ShowS
[Flagged flag a] -> ShowS
Flagged flag a -> String
(Int -> Flagged flag a -> ShowS)
-> (Flagged flag a -> String)
-> ([Flagged flag a] -> ShowS)
-> Show (Flagged flag a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall flag a.
(Show flag, Show a) =>
Int -> Flagged flag a -> ShowS
forall flag a. (Show flag, Show a) => [Flagged flag a] -> ShowS
forall flag a. (Show flag, Show a) => Flagged flag a -> String
$cshowsPrec :: forall flag a.
(Show flag, Show a) =>
Int -> Flagged flag a -> ShowS
showsPrec :: Int -> Flagged flag a -> ShowS
$cshow :: forall flag a. (Show flag, Show a) => Flagged flag a -> String
show :: Flagged flag a -> String
$cshowList :: forall flag a. (Show flag, Show a) => [Flagged flag a] -> ShowS
showList :: [Flagged flag a] -> ShowS
Show)

-- | Boolean flagging wrapper for input tree nodes
--   ('Language.Ltml.Tree.FlaggedInputTree') and AST nodes.
--
--   The flag indicates whether output should be generated for the respective
--   flagged node.
--
--   Flags always match between corresponding input tree nodes and AST nodes;
--   in particular, in the AST, the flag is only ever positive for nodes that
--   correspond to a node in the input tree.
type Flagged' = Flagged Bool

flagMap :: (fl -> fl') -> Flagged fl a -> Flagged fl' a
flagMap :: forall fl fl' a. (fl -> fl') -> Flagged fl a -> Flagged fl' a
flagMap fl -> fl'
f (Flagged fl
flag a
x) = fl' -> a -> Flagged fl' a
forall flag a. flag -> a -> Flagged flag a
Flagged (fl -> fl'
f fl
flag) a
x

instance TraversableF (Flagged flag) where
    traverseF :: forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> Flagged flag a -> f (Flagged flag b)
traverseF a -> f b
f (Flagged flag
flag a
x) = flag -> b -> Flagged flag b
forall flag a. flag -> a -> Flagged flag a
Flagged flag
flag (b -> Flagged flag b) -> f b -> f (Flagged flag b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

type ParseError = ParseErrorBundle Text Void

-- | @'Parsed' x@ denotes a node that may (!) have been parsed from text
--   (a leaf of the input tree), in which case parsing may have failed.
--   It only ever wraps nodes that correspond to nodes in the input tree.
--   I.e., this is used with nodes that can correspond to leaf nodes in the
--   input tree.
type Parsed = Either ParseError

data NavTocHeaded a = NavTocHeaded NavTocHeading a
    deriving (Int -> NavTocHeaded a -> ShowS
[NavTocHeaded a] -> ShowS
NavTocHeaded a -> String
(Int -> NavTocHeaded a -> ShowS)
-> (NavTocHeaded a -> String)
-> ([NavTocHeaded a] -> ShowS)
-> Show (NavTocHeaded a)
forall a. Show a => Int -> NavTocHeaded a -> ShowS
forall a. Show a => [NavTocHeaded a] -> ShowS
forall a. Show a => NavTocHeaded a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NavTocHeaded a -> ShowS
showsPrec :: Int -> NavTocHeaded a -> ShowS
$cshow :: forall a. Show a => NavTocHeaded a -> String
show :: NavTocHeaded a -> String
$cshowList :: forall a. Show a => [NavTocHeaded a] -> ShowS
showList :: [NavTocHeaded a] -> ShowS
Show)