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

    module Typst.Util
      ( TypeSpec (..),
        makeElement,
        makeElementWithScope,
        makeFunction,
        makeFunctionWithScope,
        makeSymbolMap,
        argsToFields,
        nthArg,
        namedArg,
        allArgs
      )
    where

    import Control.Monad (foldM)
    import Control.Monad.Reader (ReaderT (runReaderT), asks)
    import Data.List (foldl')
    import qualified Data.Map as M
    import qualified Data.Map.Ordered as OM
    import qualified Data.Sequence as Seq
    import qualified Data.Set as Set
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Vector as V
    import Text.Parsec (getPosition)
    import Typst.Types

    data TypeSpec
      = One ValType
      | Many ValType
      deriving (Int -> TypeSpec -> ShowS
    [TypeSpec] -> ShowS
    TypeSpec -> String
    (Int -> TypeSpec -> ShowS)
    -> (TypeSpec -> String) -> ([TypeSpec] -> ShowS) -> Show TypeSpec
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TypeSpec -> ShowS
    showsPrec :: Int -> TypeSpec -> ShowS
    $cshow :: TypeSpec -> String
    show :: TypeSpec -> String
    $cshowList :: [TypeSpec] -> ShowS
    showList :: [TypeSpec] -> ShowS
    Show, TypeSpec -> TypeSpec -> Bool
    (TypeSpec -> TypeSpec -> Bool)
    -> (TypeSpec -> TypeSpec -> Bool) -> Eq TypeSpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TypeSpec -> TypeSpec -> Bool
    == :: TypeSpec -> TypeSpec -> Bool
    $c/= :: TypeSpec -> TypeSpec -> Bool
    /= :: TypeSpec -> TypeSpec -> Bool
    Eq)

    insertOM :: Ord k => k -> v -> OM.OMap k v -> OM.OMap k v
    insertOM :: forall k v. Ord k => k -> v -> OMap k v -> OMap k v
    insertOM k
    k v
    v OMap k v
    m = OMap k v
    m OMap k v -> (k, v) -> OMap k v
    forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
    OM.|> (k
    k, v
    v)

    -- | Create element function with names for positional parameters.
    makeElement :: Maybe Identifier -> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
    makeElement :: Maybe Identifier
    -> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
    makeElement Maybe Identifier
    mbNamespace Identifier
    name [(Identifier, TypeSpec)]
    specs =
      Maybe Identifier
    -> Identifier
    -> [(Identifier, TypeSpec)]
    -> Map Identifier Val
    -> (Identifier, Val)
    makeElementWithScope Maybe Identifier
    mbNamespace Identifier
    name [(Identifier, TypeSpec)]
    specs Map Identifier Val
    forall a. Monoid a => a
    mempty

    -- | Create element function with names for positional parameters.
    makeElementWithScope ::
      Maybe Identifier ->
      Identifier ->
      [(Identifier, TypeSpec)] ->
      M.Map Identifier Val ->
      (Identifier, Val)
    makeElementWithScope :: Maybe Identifier
    -> Identifier
    -> [(Identifier, TypeSpec)]
    -> Map Identifier Val
    -> (Identifier, Val)
    makeElementWithScope Maybe Identifier
    mbNamespace Identifier
    name [(Identifier, TypeSpec)]
    specs Map Identifier Val
    scope =
      ( Identifier
    name,
        Maybe Identifier -> Map Identifier Val -> Function -> Val
    VFunction (Identifier -> Maybe Identifier
    forall a. a -> Maybe a
    Just Identifier
    qname) Map Identifier Val
    scope (Function -> Val) -> Function -> Val
    forall a b. (a -> b) -> a -> b
    $
          (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
     -> Function)
    -> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    forall a b. (a -> b) -> a -> b
    $ \Arguments
    args -> do
            pos <- ParsecT [Markup] (EvalState m) m SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
            fields <- argsToFields specs args
            pure $ VContent . Seq.singleton $ Elt qname (Just pos) fields
      )
      where
        qname :: Identifier
    qname = case Maybe Identifier
    mbNamespace of
          Maybe Identifier
    Nothing -> Identifier
    name
          Just Identifier
    ns -> Identifier
    ns Identifier -> Identifier -> Identifier
    forall a. Semigroup a => a -> a -> a
    <> Identifier
    "." Identifier -> Identifier -> Identifier
    forall a. Semigroup a => a -> a -> a
    <> Identifier
    name

    argsToFields ::
      MonadFail m =>
      [(Identifier, TypeSpec)] ->
      Arguments ->
      m (M.Map Identifier Val)
    argsToFields :: forall (m :: * -> *).
    MonadFail m =>
    [(Identifier, TypeSpec)] -> Arguments -> m (Map Identifier Val)
    argsToFields [(Identifier, TypeSpec)]
    specs Arguments
    args' =
      OMap Identifier Val -> Map Identifier Val
    forall k v. OMap k v -> Map k v
    OM.toMap (OMap Identifier Val -> Map Identifier Val)
    -> (Arguments -> OMap Identifier Val)
    -> Arguments
    -> Map Identifier Val
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arguments -> OMap Identifier Val
    named (Arguments -> Map Identifier Val)
    -> m Arguments -> m (Map Identifier Val)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Arguments -> (Identifier, TypeSpec) -> m Arguments)
    -> Arguments -> [(Identifier, TypeSpec)] -> m Arguments
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Arguments -> (Identifier, TypeSpec) -> m Arguments
    forall {f :: * -> *}.
    Applicative f =>
    Arguments -> (Identifier, TypeSpec) -> f Arguments
    go Arguments
    args' [(Identifier, TypeSpec)]
    specs
      where
        hasType' :: ValType -> Val -> Bool
    hasType' ValType
    TContent VContent {} = Bool
    True
        hasType' ValType
    TContent VString {} = Bool
    True
        hasType' ValType
    TContent VSymbol {} = Bool
    True
        hasType' ValType
    TString (VContent Seq Content
    _) = Bool
    True
        hasType' ValType
    TTermItem VArray {} = Bool
    True
        hasType' ValType
    x Val
    y = ValType -> Val -> Bool
    hasType ValType
    x Val
    y
        toType :: ValType -> Val -> Val
    toType ValType
    TContent Val
    x = Seq Content -> Val
    VContent (Seq Content -> Val) -> Seq Content -> Val
    forall a b. (a -> b) -> a -> b
    $ Val -> Seq Content
    valToContent Val
    x
        toType ValType
    TTermItem (VArray [VContent Seq Content
    t, VContent Seq Content
    d]) = Seq Content -> Seq Content -> Val
    VTermItem Seq Content
    t Seq Content
    d
        toType ValType
    TTermItem (VArray [VContent Seq Content
    t]) = Seq Content -> Seq Content -> Val
    VTermItem Seq Content
    t Seq Content
    forall a. Monoid a => a
    mempty
        toType ValType
    TTermItem Val
    _ = Seq Content -> Seq Content -> Val
    VTermItem Seq Content
    forall a. Monoid a => a
    mempty Seq Content
    forall a. Monoid a => a
    mempty
        toType ValType
    TLabel (VContent [Lab Text
    t]) = Text -> Val
    VLabel Text
    t
        toType ValType
    _ Val
    x = Val
    x
        go :: Arguments -> (Identifier, TypeSpec) -> f Arguments
    go Arguments
    args (Identifier
    posname, Many ValType
    ty) = do
          let ([Val]
    as, [Val]
    bs) = (Val -> Bool) -> [Val] -> ([Val], [Val])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (ValType -> Val -> Bool
    hasType' ValType
    ty) (Arguments -> [Val]
    positional Arguments
    args)
          Arguments -> f Arguments
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Arguments -> f Arguments) -> Arguments -> f Arguments
    forall a b. (a -> b) -> a -> b
    $
            Arguments
    args
              { named =
                  insertOM
                    posname
                    (VArray $ V.fromList $ map (toType ty) as)
                    (named args),
                positional = bs
              }
        go Arguments
    args (Identifier
    posname, One ValType
    ty) =
          case (Val -> Bool) -> [Val] -> ([Val], [Val])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (ValType -> Val -> Bool
    hasType' ValType
    ty) (Arguments -> [Val]
    positional Arguments
    args) of
            ([], []) -> Arguments -> f Arguments
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Arguments
    args
            ([Val]
    as, Val
    b : [Val]
    bs) ->
              Arguments -> f Arguments
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Arguments -> f Arguments) -> Arguments -> f Arguments
    forall a b. (a -> b) -> a -> b
    $
                Arguments
    args
                  { named = insertOM posname (toType ty b) (named args),
                    positional = as ++ bs
                  }
            ([Val]
    _, []) ->
              Arguments -> f Arguments
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Arguments
    args

    makeFunction ::
      (forall m'. Monad m' => ReaderT Arguments (MP m') Val) -> Val
    makeFunction :: (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
    -> Val
    makeFunction forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val
    f = Maybe Identifier -> Map Identifier Val -> Function -> Val
    VFunction Maybe Identifier
    forall a. Maybe a
    Nothing Map Identifier Val
    forall a. Monoid a => a
    mempty (Function -> Val) -> Function -> Val
    forall a b. (a -> b) -> a -> b
    $ (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
     -> Function)
    -> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    forall a b. (a -> b) -> a -> b
    $ ReaderT Arguments (ParsecT [Markup] (EvalState m) m) Val
    -> Arguments -> ParsecT [Markup] (EvalState m) m Val
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT Arguments (ParsecT [Markup] (EvalState m) m) Val
    forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val
    f

    makeFunctionWithScope ::
      (forall m'. Monad m' => ReaderT Arguments (MP m') Val) ->
      M.Map Identifier Val ->
      Val
    makeFunctionWithScope :: (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
    -> Map Identifier Val -> Val
    makeFunctionWithScope forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val
    f Map Identifier Val
    m = Maybe Identifier -> Map Identifier Val -> Function -> Val
    VFunction Maybe Identifier
    forall a. Maybe a
    Nothing Map Identifier Val
    m (Function -> Val) -> Function -> Val
    forall a b. (a -> b) -> a -> b
    $ (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
     -> Function)
    -> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
    -> Function
    forall a b. (a -> b) -> a -> b
    $ ReaderT Arguments (ParsecT [Markup] (EvalState m) m) Val
    -> Arguments -> ParsecT [Markup] (EvalState m) m Val
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT Arguments (ParsecT [Markup] (EvalState m) m) Val
    forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val
    f

    nthArg ::
      (Monad m, FromVal a) =>
      Int ->
      ReaderT Arguments (MP m) a
    nthArg :: forall (m :: * -> *) a.
    (Monad m, FromVal a) =>
    Int -> ReaderT Arguments (MP m) a
    nthArg Int
    num = Int -> ReaderT Arguments (MP m) Val
    forall (m :: * -> *).
    Monad m =>
    Int -> ReaderT Arguments (MP m) Val
    getPositional (Int
    num Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) ReaderT Arguments (MP m) Val
    -> (Val -> ReaderT Arguments (MP m) a)
    -> ReaderT Arguments (MP m) a
    forall a b.
    ReaderT Arguments (MP m) a
    -> (a -> ReaderT Arguments (MP m) b) -> ReaderT Arguments (MP m) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Val -> ReaderT Arguments (MP m) a
    forall a (m :: * -> *).
    (FromVal a, MonadPlus m, MonadFail m) =>
    Val -> m a
    forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m a
    fromVal

    getPositional :: Monad m => Int -> ReaderT Arguments (MP m) Val
    getPositional :: forall (m :: * -> *).
    Monad m =>
    Int -> ReaderT Arguments (MP m) Val
    getPositional Int
    idx = do
      xs <- (Arguments -> [Val]) -> ReaderT Arguments (MP m) [Val]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Arguments -> [Val]
    positional
      if idx >= length xs
        then pure VNone
        else pure $ xs !! idx

    getNamed :: Monad m => Identifier -> ReaderT Arguments (MP m) (Maybe Val)
    getNamed :: forall (m :: * -> *).
    Monad m =>
    Identifier -> ReaderT Arguments (MP m) (Maybe Val)
    getNamed Identifier
    ident = do
      m <- (Arguments -> OMap Identifier Val)
    -> ReaderT Arguments (MP m) (OMap Identifier Val)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Arguments -> OMap Identifier Val
    named
      pure $ OM.lookup ident m

    namedArg ::
      (Monad m, FromVal a) =>
      Identifier ->
      a ->
      ReaderT Arguments (MP m) a
    namedArg :: forall (m :: * -> *) a.
    (Monad m, FromVal a) =>
    Identifier -> a -> ReaderT Arguments (MP m) a
    namedArg ident :: Identifier
    ident@(Identifier Text
    _) a
    defaultVal = do
      mbval <- Identifier -> ReaderT Arguments (MP m) (Maybe Val)
    forall (m :: * -> *).
    Monad m =>
    Identifier -> ReaderT Arguments (MP m) (Maybe Val)
    getNamed Identifier
    ident
      case mbval of
        Just Val
    val -> Val -> ReaderT Arguments (MP 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
    val
        Maybe Val
    Nothing -> a -> ReaderT Arguments (MP m) a
    forall a. a -> ReaderT Arguments (MP m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    defaultVal

    allArgs :: Monad m => ReaderT Arguments (MP m) [Val]
    allArgs :: forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
    allArgs = (Arguments -> [Val]) -> ReaderT Arguments (MP m) [Val]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Arguments -> [Val]
    positional

    makeSymbolMap :: [(Text, Bool, Text)] -> M.Map Identifier Symbol
    makeSymbolMap :: [(Text, Bool, Text)] -> Map Identifier Symbol
    makeSymbolMap = (Map Identifier Symbol
     -> (Text, Bool, Text) -> Map Identifier Symbol)
    -> Map Identifier Symbol
    -> [(Text, Bool, Text)]
    -> Map Identifier Symbol
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Map Identifier Symbol
    -> (Text, Bool, Text) -> Map Identifier Symbol
    go Map Identifier Symbol
    forall a. Monoid a => a
    mempty
      where
        go :: M.Map Identifier Symbol -> (Text, Bool, Text) -> M.Map Identifier Symbol
        go :: Map Identifier Symbol
    -> (Text, Bool, Text) -> Map Identifier Symbol
    go Map Identifier Symbol
    m (Text
    name, Bool
    accent, Text
    v) =
          case (Char -> Bool) -> Text -> [Text]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') Text
    name of
            [] -> Map Identifier Symbol
    m
            (Text
    k : [Text]
    ks) ->
              (Maybe Symbol -> Maybe Symbol)
    -> Identifier -> Map Identifier Symbol -> Map Identifier Symbol
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    M.alter
                ( \case
                    Maybe Symbol
    Nothing ->
                      Symbol -> Maybe Symbol
    forall a. a -> Maybe a
    Just (Symbol -> Maybe Symbol) -> Symbol -> Maybe Symbol
    forall a b. (a -> b) -> a -> b
    $ Text -> Bool -> [(Set Text, Text)] -> Symbol
    Symbol Text
    v Bool
    accent ([Text] -> Text -> [(Set Text, Text)] -> [(Set Text, Text)]
    addVariant [Text]
    ks Text
    v [(Set Text, Text)]
    forall a. Monoid a => a
    mempty)
                    Just (Symbol Text
    dv Bool
    da [(Set Text, Text)]
    vs) ->
                      Symbol -> Maybe Symbol
    forall a. a -> Maybe a
    Just (Symbol -> Maybe Symbol) -> Symbol -> Maybe Symbol
    forall a b. (a -> b) -> a -> b
    $ Text -> Bool -> [(Set Text, Text)] -> Symbol
    Symbol Text
    dv' Bool
    da [(Set Text, Text)]
    variants
                      where variants :: [(Set Text, Text)]
    variants = [Text] -> Text -> [(Set Text, Text)] -> [(Set Text, Text)]
    addVariant [Text]
    ks Text
    v [(Set Text, Text)]
    vs
                            minModifiers :: Int
    minModifiers = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((Set Text, Text) -> Int) -> [(Set Text, Text)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Set Text -> Int
    forall a. Set a -> Int
    Set.size (Set Text -> Int)
    -> ((Set Text, Text) -> Set Text) -> (Set Text, Text) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set Text, Text) -> Set Text
    forall a b. (a, b) -> a
    fst) [(Set Text, Text)]
    variants
                            shortestVariants :: [(Set Text, Text)]
    shortestVariants =
                              ((Set Text, Text) -> Bool)
    -> [(Set Text, Text)] -> [(Set Text, Text)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    minModifiers) (Int -> Bool)
    -> ((Set Text, Text) -> Int) -> (Set Text, Text) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set Text -> Int
    forall a. Set a -> Int
    Set.size (Set Text -> Int)
    -> ((Set Text, Text) -> Set Text) -> (Set Text, Text) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set Text, Text) -> Set Text
    forall a b. (a, b) -> a
    fst) [(Set Text, Text)]
    variants
                             -- "When displaying a symbol, Typst selects the first
                             -- from the variants that have all attached modifiers
                             -- and the minimum number of other modifiers."
                            dv' :: Text
    dv' = case ((Set Text, Text) -> Text) -> [(Set Text, Text)] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Set Text, Text) -> Text
    forall a b. (a, b) -> b
    snd [(Set Text, Text)]
    shortestVariants of
                                      [] -> Text
    dv
                                      (Text
    x:[Text]
    _) -> Text
    x
                )
                (Text -> Identifier
    Identifier Text
    k)
                Map Identifier Symbol
    m
        addVariant ::
          [Text] ->
          Text ->
          [(Set.Set Text, Text)] ->
          [(Set.Set Text, Text)]
        addVariant :: [Text] -> Text -> [(Set Text, Text)] -> [(Set Text, Text)]
    addVariant [Text]
    ks Text
    v = ([(Set Text, Text)] -> [(Set Text, Text)] -> [(Set Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++ [([Text] -> Set Text
    forall a. Ord a => [a] -> Set a
    Set.fromList [Text]
    ks, Text
    v)])