{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.Pandoc.Readers.Typst.Parsing
  ( P,
    PState(..),
    defaultPState,
    pTok,
    pWithContents,
    ignored,
    getField,
    chunks,
  )
where
import Control.Monad (MonadPlus)
import Control.Monad.Reader (lift)
import qualified Data.Foldable as F
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Text (Text)
import Text.Parsec
    ( ParsecT, getInput, setInput, tokenPrim )
import Typst.Types
    ( Identifier, Content(Elt), FromVal(..), Val(VNone) )
import Text.Pandoc.Class.PandocMonad ( PandocMonad, report )
import Text.Pandoc.Logging (LogMessage(..))

newtype PState = PState
        { PState -> [Text]
sLabels :: [Text]}
        deriving (Int -> PState -> ShowS
[PState] -> ShowS
PState -> String
(Int -> PState -> ShowS)
-> (PState -> String) -> ([PState] -> ShowS) -> Show PState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PState -> ShowS
showsPrec :: Int -> PState -> ShowS
$cshow :: PState -> String
show :: PState -> String
$cshowList :: [PState] -> ShowS
showList :: [PState] -> ShowS
Show)

defaultPState :: PState
defaultPState :: PState
defaultPState =
  PState
  { sLabels :: [Text]
sLabels = [] }

type P m a = ParsecT [Content] PState m a
-- state tracks a list of labels in the document

pTok :: PandocMonad m => (Content -> Bool) -> P m Content
pTok :: forall (m :: * -> *).
PandocMonad m =>
(Content -> Bool) -> P m Content
pTok Content -> Bool
f = (Content -> String)
-> (SourcePos -> Content -> [Content] -> SourcePos)
-> (Content -> Maybe Content)
-> ParsecT [Content] PState m Content
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim Content -> String
forall a. Show a => a -> String
show SourcePos -> Content -> [Content] -> SourcePos
forall {p}. SourcePos -> Content -> p -> SourcePos
showPos Content -> Maybe Content
match
  where
    showPos :: SourcePos -> Content -> p -> SourcePos
showPos SourcePos
_oldpos (Elt Identifier
_ (Just SourcePos
pos) Map Identifier Val
_) p
_ = SourcePos
pos
    showPos SourcePos
oldpos Content
_ p
_ = SourcePos
oldpos
    match :: Content -> Maybe Content
match Content
x | Content -> Bool
f Content
x = Content -> Maybe Content
forall a. a -> Maybe a
Just Content
x
    match Content
_ = Maybe Content
forall a. Maybe a
Nothing

ignored :: PandocMonad m => Text -> P m ()
ignored :: forall (m :: * -> *). PandocMonad m => Text -> P m ()
ignored Text
msg = m () -> ParsecT [Content] PState m ()
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Content] PState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParsecT [Content] PState m ())
-> m () -> ParsecT [Content] PState m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredElement Text
msg

pWithContents :: PandocMonad m => P m a -> Seq Content -> P m a
pWithContents :: forall (m :: * -> *) a.
PandocMonad m =>
P m a -> Seq Content -> P m a
pWithContents P m a
pa Seq Content
cs = do
  [Content]
inp <- ParsecT [Content] PState m [Content]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  [Content] -> ParsecT [Content] PState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput ([Content] -> ParsecT [Content] PState m ())
-> [Content] -> ParsecT [Content] PState m ()
forall a b. (a -> b) -> a -> b
$ Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs
  a
res <- P m a
pa
  [Content] -> ParsecT [Content] PState m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Content]
inp
  a -> P m a
forall a. a -> ParsecT [Content] PState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

-- | Get field value from element, defaulting to VNone.
getField ::
  (MonadFail m, MonadPlus m, FromVal a) =>
  Identifier ->
  M.Map Identifier Val ->
  m a
getField :: forall (m :: * -> *) a.
(MonadFail m, MonadPlus m, FromVal a) =>
Identifier -> Map Identifier Val -> m a
getField Identifier
name Map Identifier Val
fields = Val -> m a
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
fromVal (Val -> m a) -> Val -> m a
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val -> Val
forall a. a -> Maybe a -> a
fromMaybe Val
VNone (Maybe Val -> Val) -> Maybe Val -> Val
forall a b. (a -> b) -> a -> b
$ Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
name Map Identifier Val
fields

-- | Split a list into chunks of a given size. The last chunk may be smaller.
chunks :: Int -> [a] -> [[a]]
chunks :: forall a. Int -> [a] -> [[a]]
chunks Int
_ [] = []
chunks Int
n [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunks Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs)