    {-# LANGUAGE RankNTypes #-}

    module Typst.Bind (destructuringBind) where

    import Control.Monad.State
    import qualified Data.Map.Ordered as OM
    import Data.Maybe (fromMaybe)
    import qualified Data.Vector as V
    import Typst.Syntax
    import Typst.Types

    destructuringBind ::
      Monad m =>
      (forall m'. Monad m' => Identifier -> Val -> MP m' ()) ->
      [BindPart] ->
      Val ->
      MP m ()
    destructuringBind :: forall (m :: * -> *).
    Monad m =>
    (forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart] -> Val -> MP m ()
    destructuringBind forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier [BindPart]
    parts Val
    val = do
      let isSink :: BindPart -> Bool
    isSink Sink {} = Bool
    True
          isSink BindPart
    _ = Bool
    False
      let ([BindPart]
    fronts, [BindPart]
    rest) = (BindPart -> Bool) -> [BindPart] -> ([BindPart], [BindPart])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break BindPart -> Bool
    isSink [BindPart]
    parts
      let ([BindPart]
    sinks, [BindPart]
    backs) = (BindPart -> Bool) -> [BindPart] -> ([BindPart], [BindPart])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span BindPart -> Bool
    isSink [BindPart]
    rest
      mbsink <- case [BindPart]
    sinks of
        [Sink Maybe Identifier
    s] -> Maybe Identifier
    -> ParsecT [Markup] (EvalState m) m (Maybe Identifier)
    forall a. a -> ParsecT [Markup] (EvalState m) m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Identifier
    s
        [] -> Maybe Identifier
    -> ParsecT [Markup] (EvalState m) m (Maybe Identifier)
    forall a. a -> ParsecT [Markup] (EvalState m) m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Identifier
    forall a. Maybe a
    Nothing
        [BindPart]
    _ -> String -> ParsecT [Markup] (EvalState m) m (Maybe Identifier)
    forall a. String -> ParsecT [Markup] (EvalState m) m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Bind cannot contain multiple sinks"
      case val of
        VDict OMap Identifier Val
    m ->
          StateT (OMap Identifier Val) (ParsecT [Markup] (EvalState m) m) ()
    -> OMap Identifier Val -> ParsecT [Markup] (EvalState m) m ()
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ((forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT
         (OMap Identifier Val) (ParsecT [Markup] (EvalState m) m) ()
    forall (m :: * -> *).
    Monad m =>
    (forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT (OMap Identifier Val) (MP m) ()
    destructureDict Identifier -> Val -> MP m' ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier [BindPart]
    fronts [BindPart]
    backs Maybe Identifier
    mbsink) OMap Identifier Val
    m
        VArray Vector Val
    v ->
          StateT (Vector Val) (ParsecT [Markup] (EvalState m) m) ()
    -> Vector Val -> ParsecT [Markup] (EvalState m) m ()
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ((forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT (Vector Val) (ParsecT [Markup] (EvalState m) m) ()
    forall (m :: * -> *).
    Monad m =>
    (forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT (Vector Val) (MP m) ()
    destructureArray Identifier -> Val -> MP m' ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier [BindPart]
    fronts [BindPart]
    backs Maybe Identifier
    mbsink) Vector Val
    v
        Val
    _ -> String -> ParsecT [Markup] (EvalState m) m ()
    forall a. String -> ParsecT [Markup] (EvalState m) m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Only Array or Dictionary values can be destructured"

    destructureDict ::
      Monad m =>
      (forall m'. Monad m' => Identifier -> Val -> MP m' ()) ->
      [BindPart] ->
      [BindPart] ->
      Maybe Identifier ->
      StateT (OM.OMap Identifier Val) (MP m) ()
    destructureDict :: forall (m :: * -> *).
    Monad m =>
    (forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT (OMap Identifier Val) (MP m) ()
    destructureDict forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier [BindPart]
    fronts [BindPart]
    backs Maybe Identifier
    mbsink = do
      (BindPart -> StateT (OMap Identifier Val) (MP m) ())
    -> [BindPart] -> StateT (OMap Identifier Val) (MP m) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BindPart -> StateT (OMap Identifier Val) (MP m) ()
    forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (OMap Identifier Val) (MP m) ()
    handleDictBind ([BindPart]
    fronts [BindPart] -> [BindPart] -> [BindPart]
    forall a. [a] -> [a] -> [a]
    ++ [BindPart]
    backs)
      case Maybe Identifier
    mbsink of
        Just Identifier
    i -> StateT (OMap Identifier Val) (MP m) (OMap Identifier Val)
    forall s (m :: * -> *). MonadState s m => m s
    get StateT (OMap Identifier Val) (MP m) (OMap Identifier Val)
    -> (OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ())
    -> StateT (OMap Identifier Val) (MP m) ()
    forall a b.
    StateT (OMap Identifier Val) (MP m) a
    -> (a -> StateT (OMap Identifier Val) (MP m) b)
    -> StateT (OMap Identifier Val) (MP m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MP m () -> StateT (OMap Identifier Val) (MP m) ()
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (OMap Identifier Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (OMap Identifier Val) (MP m) ())
    -> (OMap Identifier Val -> MP m ())
    -> OMap Identifier Val
    -> StateT (OMap Identifier Val) (MP m) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier Identifier
    i (Val -> MP m ())
    -> (OMap Identifier Val -> Val) -> OMap Identifier Val -> MP m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OMap Identifier Val -> Val
    VDict
        Maybe Identifier
    Nothing -> () -> StateT (OMap Identifier Val) (MP m) ()
    forall a. a -> StateT (OMap Identifier Val) (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        handleDictBind :: Monad m => BindPart -> StateT (OM.OMap Identifier Val) (MP m) ()
        handleDictBind :: forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (OMap Identifier Val) (MP m) ()
    handleDictBind (Sink {}) = String -> StateT (OMap Identifier Val) (MP m) ()
    forall a. String -> StateT (OMap Identifier Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Bind cannot contain multiple sinks"
        handleDictBind (Simple Maybe Identifier
    Nothing) = () -> StateT (OMap Identifier Val) (MP m) ()
    forall a. a -> StateT (OMap Identifier Val) (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        handleDictBind (Simple (Just Identifier
    i)) = do
          m <- StateT (OMap Identifier Val) (MP m) (OMap Identifier Val)
    forall s (m :: * -> *). MonadState s m => m s
    get
          case OM.lookup i m of
            Maybe Val
    Nothing ->
              String -> StateT (OMap Identifier Val) (MP m) ()
    forall a. String -> StateT (OMap Identifier Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> StateT (OMap Identifier Val) (MP m) ())
    -> String -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Destructuring key not found in dictionary: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Identifier -> String
    forall a. Show a => a -> String
    show Identifier
    i
            Just Val
    v -> do
              OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ())
    -> OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> OMap Identifier Val -> OMap Identifier Val
    forall k v. Ord k => k -> OMap k v -> OMap k v
    OM.delete Identifier
    i OMap Identifier Val
    m
              MP m () -> StateT (OMap Identifier Val) (MP m) ()
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (OMap Identifier Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (OMap Identifier Val) (MP m) ())
    -> MP m () -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier Identifier
    i Val
    v
        handleDictBind (WithKey Identifier
    key Maybe Identifier
    mbident) = do
          m <- StateT (OMap Identifier Val) (MP m) (OMap Identifier Val)
    forall s (m :: * -> *). MonadState s m => m s
    get
          case OM.lookup key m of
            Maybe Val
    Nothing ->
              String -> StateT (OMap Identifier Val) (MP m) ()
    forall a. String -> StateT (OMap Identifier Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> StateT (OMap Identifier Val) (MP m) ())
    -> String -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Destructuring key not found in dictionary: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Identifier -> String
    forall a. Show a => a -> String
    show Identifier
    key
            Just Val
    v -> do
              OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ())
    -> OMap Identifier Val -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> OMap Identifier Val -> OMap Identifier Val
    forall k v. Ord k => k -> OMap k v -> OMap k v
    OM.delete Identifier
    key OMap Identifier Val
    m
              MP m () -> StateT (OMap Identifier Val) (MP m) ()
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (OMap Identifier Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (OMap Identifier Val) (MP m) ())
    -> MP m () -> StateT (OMap Identifier Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier (Identifier -> Maybe Identifier -> Identifier
    forall a. a -> Maybe a -> a
    fromMaybe Identifier
    key Maybe Identifier
    mbident) Val
    v

    destructureArray ::
      Monad m =>
      (forall m'. Monad m' => Identifier -> Val -> MP m' ()) ->
      [BindPart] ->
      [BindPart] ->
      Maybe Identifier ->
      StateT (V.Vector Val) (MP m) ()
    destructureArray :: forall (m :: * -> *).
    Monad m =>
    (forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ())
    -> [BindPart]
    -> [BindPart]
    -> Maybe Identifier
    -> StateT (Vector Val) (MP m) ()
    destructureArray forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier [BindPart]
    fronts [BindPart]
    backs Maybe Identifier
    mbsink = do
      (BindPart -> StateT (Vector Val) (MP m) ())
    -> [BindPart] -> StateT (Vector Val) (MP m) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BindPart -> StateT (Vector Val) (MP m) ()
    forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (Vector Val) (MP m) ()
    handleFrontBind [BindPart]
    fronts
      (BindPart -> StateT (Vector Val) (MP m) ())
    -> [BindPart] -> StateT (Vector Val) (MP m) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BindPart -> StateT (Vector Val) (MP m) ()
    forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (Vector Val) (MP m) ()
    handleBackBind ([BindPart] -> [BindPart]
    forall a. [a] -> [a]
    reverse [BindPart]
    backs)
      case Maybe Identifier
    mbsink of
        Just Identifier
    i -> StateT (Vector Val) (MP m) (Vector Val)
    forall s (m :: * -> *). MonadState s m => m s
    get StateT (Vector Val) (MP m) (Vector Val)
    -> (Vector Val -> StateT (Vector Val) (MP m) ())
    -> StateT (Vector Val) (MP m) ()
    forall a b.
    StateT (Vector Val) (MP m) a
    -> (a -> StateT (Vector Val) (MP m) b)
    -> StateT (Vector Val) (MP m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MP m () -> StateT (Vector Val) (MP m) ()
    forall (m :: * -> *) a. Monad m => m a -> StateT (Vector Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (Vector Val) (MP m) ())
    -> (Vector Val -> MP m ())
    -> Vector Val
    -> StateT (Vector Val) (MP m) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier Identifier
    i (Val -> MP m ()) -> (Vector Val -> Val) -> Vector Val -> MP m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Val -> Val
    VArray
        Maybe Identifier
    Nothing -> () -> StateT (Vector Val) (MP m) ()
    forall a. a -> StateT (Vector Val) (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        handleFrontBind :: Monad m => BindPart -> StateT (V.Vector Val) (MP m) ()
        handleFrontBind :: forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (Vector Val) (MP m) ()
    handleFrontBind (Sink {}) = String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Bind cannot contain multiple sinks"
        handleFrontBind (WithKey {}) = String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot destructure array with key"
        handleFrontBind (Simple Maybe Identifier
    mbi) = do
          v <- StateT (Vector Val) (MP m) (Vector Val)
    forall s (m :: * -> *). MonadState s m => m s
    get
          case V.uncons v of
            Maybe (Val, Vector Val)
    Nothing -> String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Array does not contain enough elements to destructure"
            Just (Val
    x, Vector Val
    v') -> do
              Vector Val -> StateT (Vector Val) (MP m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put Vector Val
    v'
              case Maybe Identifier
    mbi of
                Maybe Identifier
    Nothing -> () -> StateT (Vector Val) (MP m) ()
    forall a. a -> StateT (Vector Val) (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                Just Identifier
    i -> MP m () -> StateT (Vector Val) (MP m) ()
    forall (m :: * -> *) a. Monad m => m a -> StateT (Vector Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (Vector Val) (MP m) ())
    -> MP m () -> StateT (Vector Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier Identifier
    i Val
    x

        handleBackBind :: Monad m => BindPart -> StateT (V.Vector Val) (MP m) ()
        handleBackBind :: forall (m :: * -> *).
    Monad m =>
    BindPart -> StateT (Vector Val) (MP m) ()
    handleBackBind (Sink {}) = String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Bind cannot contain multiple sinks"
        handleBackBind (WithKey {}) = String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Cannot destructure array with key"
        handleBackBind (Simple Maybe Identifier
    mbi) = do
          v <- StateT (Vector Val) (MP m) (Vector Val)
    forall s (m :: * -> *). MonadState s m => m s
    get
          case V.unsnoc v of
            Maybe (Vector Val, Val)
    Nothing -> String -> StateT (Vector Val) (MP m) ()
    forall a. String -> StateT (Vector Val) (MP m) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Array does not contain enough elements to destructure"
            Just (Vector Val
    v', Val
    x) -> do
              Vector Val -> StateT (Vector Val) (MP m) ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put Vector Val
    v'
              case Maybe Identifier
    mbi of
                Maybe Identifier
    Nothing -> () -> StateT (Vector Val) (MP m) ()
    forall a. a -> StateT (Vector Val) (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                Just Identifier
    i -> MP m () -> StateT (Vector Val) (MP m) ()
    forall (m :: * -> *) a. Monad m => m a -> StateT (Vector Val) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (MP m () -> StateT (Vector Val) (MP m) ())
    -> MP m () -> StateT (Vector Val) (MP m) ()
    forall a b. (a -> b) -> a -> b
    $ Identifier -> Val -> MP m ()
    forall (m' :: * -> *). Monad m' => Identifier -> Val -> MP m' ()
    setIdentifier Identifier
    i Val
    x