    {-|
    Module      : Toml.Semantics.Ordered
    Description : Tool for extracting an ordering from an existing TOML file
    Copyright   : (c) Eric Mertens, 2023
    License     : ISC
    Maintainer  : emertens@gmail.com

    This module can help build a key ordering projection given an existing
    TOML file. This could be useful for applying a transformation to a TOML
    file before pretty-printing it back in something very close to the
    original order.

    When using the computed order, table keys will be remembered in the order
    they appeared in the source file. Any key additional keys added to the
    tables will be ordered alphabetically after all the known keys.

    @
    demo =
     do txt <- 'readFile' \"demo.toml\"
        let Right exprs = 'Toml.Parser.parseRawToml' txt
            to          = 'extractTableOrder' exprs
            Right toml  = 'Toml.Semantics.semantics' exprs
            projection  = 'projectKey' to
        'print' ('Toml.Pretty.prettyTomlOrdered' projection toml)
    @

    -}
    module Toml.Semantics.Ordered (
        TableOrder,
        extractTableOrder,
        projectKey,
        ProjectedKey,
        debugTableOrder,
        ) where

    import Data.Foldable (foldl', toList)
    import Data.List (sortOn)
    import Data.Map (Map)
    import Data.Map qualified as Map
    import Data.Text (Text)
    import Data.Text qualified as Text
    import Toml.Syntax.Types (Expr(..), Key, Val(ValTable, ValArray))

    -- | Summary of the order of the keys in a TOML document.
    newtype TableOrder = TO (Map Text KeyOrder)

    -- | Internal type used by 'TableOrder'
    --
    -- The 'Int' field determines the order of the current key and the
    -- 'TableOrder' determines the order of the children of this key.
    data KeyOrder = KeyOrder !Int TableOrder

    -- | Opaque type used by 'projectKey'
    newtype ProjectedKey = PK (Either Int Text)
        deriving (ProjectedKey -> ProjectedKey -> Bool
    (ProjectedKey -> ProjectedKey -> Bool)
    -> (ProjectedKey -> ProjectedKey -> Bool) -> Eq ProjectedKey
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ProjectedKey -> ProjectedKey -> Bool
    == :: ProjectedKey -> ProjectedKey -> Bool
    $c/= :: ProjectedKey -> ProjectedKey -> Bool
    /= :: ProjectedKey -> ProjectedKey -> Bool
    Eq, Eq ProjectedKey
    Eq ProjectedKey =>
    (ProjectedKey -> ProjectedKey -> Ordering)
    -> (ProjectedKey -> ProjectedKey -> Bool)
    -> (ProjectedKey -> ProjectedKey -> Bool)
    -> (ProjectedKey -> ProjectedKey -> Bool)
    -> (ProjectedKey -> ProjectedKey -> Bool)
    -> (ProjectedKey -> ProjectedKey -> ProjectedKey)
    -> (ProjectedKey -> ProjectedKey -> ProjectedKey)
    -> Ord ProjectedKey
    ProjectedKey -> ProjectedKey -> Bool
    ProjectedKey -> ProjectedKey -> Ordering
    ProjectedKey -> ProjectedKey -> ProjectedKey
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ProjectedKey -> ProjectedKey -> Ordering
    compare :: ProjectedKey -> ProjectedKey -> Ordering
    $c< :: ProjectedKey -> ProjectedKey -> Bool
    < :: ProjectedKey -> ProjectedKey -> Bool
    $c<= :: ProjectedKey -> ProjectedKey -> Bool
    <= :: ProjectedKey -> ProjectedKey -> Bool
    $c> :: ProjectedKey -> ProjectedKey -> Bool
    > :: ProjectedKey -> ProjectedKey -> Bool
    $c>= :: ProjectedKey -> ProjectedKey -> Bool
    >= :: ProjectedKey -> ProjectedKey -> Bool
    $cmax :: ProjectedKey -> ProjectedKey -> ProjectedKey
    max :: ProjectedKey -> ProjectedKey -> ProjectedKey
    $cmin :: ProjectedKey -> ProjectedKey -> ProjectedKey
    min :: ProjectedKey -> ProjectedKey -> ProjectedKey
    Ord)

    -- | Generate a projection function for use with 'Toml.Pretty.prettyTomlOrdered'
    projectKey ::
        TableOrder   {- ^ table order                           -} ->
        [Text]       {- ^ table path                            -} ->
        Text         {- ^ key                                   -} ->
        ProjectedKey {- ^ type suitable for ordering table keys -}
    projectKey :: TableOrder -> [Text] -> Text -> ProjectedKey
    projectKey (TO Map Text KeyOrder
    to) [] = \Text
    k ->
        case Text -> Map Text KeyOrder -> Maybe KeyOrder
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    k Map Text KeyOrder
    to of
            Just (KeyOrder Int
    i TableOrder
    _)     -> Either Int Text -> ProjectedKey
    PK (Int -> Either Int Text
    forall a b. a -> Either a b
    Left Int
    i)
            Maybe KeyOrder
    Nothing                 -> Either Int Text -> ProjectedKey
    PK (Text -> Either Int Text
    forall a b. b -> Either a b
    Right Text
    k)
    projectKey (TO Map Text KeyOrder
    to) (Text
    p:[Text]
    ps) =
        case Text -> Map Text KeyOrder -> Maybe KeyOrder
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    p Map Text KeyOrder
    to of
            Just (KeyOrder Int
    _ TableOrder
    to')   -> TableOrder -> [Text] -> Text -> ProjectedKey
    projectKey TableOrder
    to' [Text]
    ps
            Maybe KeyOrder
    Nothing                 -> Either Int Text -> ProjectedKey
    PK (Either Int Text -> ProjectedKey)
    -> (Text -> Either Int Text) -> Text -> ProjectedKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either Int Text
    forall a b. b -> Either a b
    Right

    emptyOrder :: TableOrder
    emptyOrder :: TableOrder
    emptyOrder = Map Text KeyOrder -> TableOrder
    TO Map Text KeyOrder
    forall k a. Map k a
    Map.empty

    -- | Extract a 'TableOrder' from the output of 'Toml.Parser.parseRawToml'
    -- to be later used with 'projectKey'.
    extractTableOrder :: [Expr a] -> TableOrder
    extractTableOrder :: forall a. [Expr a] -> TableOrder
    extractTableOrder = ([Text], TableOrder) -> TableOrder
    forall a b. (a, b) -> b
    snd (([Text], TableOrder) -> TableOrder)
    -> ([Expr a] -> ([Text], TableOrder)) -> [Expr a] -> TableOrder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Text], TableOrder) -> Expr a -> ([Text], TableOrder))
    -> ([Text], TableOrder) -> [Expr a] -> ([Text], TableOrder)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([Text], TableOrder) -> Expr a -> ([Text], TableOrder)
    forall a. ([Text], TableOrder) -> Expr a -> ([Text], TableOrder)
    addExpr ([], TableOrder
    emptyOrder)

    addExpr :: ([Text], TableOrder) -> Expr a -> ([Text], TableOrder)
    addExpr :: forall a. ([Text], TableOrder) -> Expr a -> ([Text], TableOrder)
    addExpr ([Text]
    prefix, TableOrder
    to) = \case
        TableExpr Key a
    k      -> let k' :: [Text]
    k' = Key a -> [Text]
    forall a. Key a -> [Text]
    keyPath Key a
    k in ([Text]
    k', TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    to [Text]
    k')
        ArrayTableExpr Key a
    k -> let k' :: [Text]
    k' = Key a -> [Text]
    forall a. Key a -> [Text]
    keyPath Key a
    k in ([Text]
    k', TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    to [Text]
    k')
        KeyValExpr Key a
    k Val a
    v   -> ([Text]
    prefix, [Text] -> TableOrder -> Val a -> TableOrder
    forall a. [Text] -> TableOrder -> Val a -> TableOrder
    addVal [Text]
    prefix (TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    to ([Text]
    prefix [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ Key a -> [Text]
    forall a. Key a -> [Text]
    keyPath Key a
    k)) Val a
    v)

    addVal :: [Text] -> TableOrder -> Val a -> TableOrder
    addVal :: forall a. [Text] -> TableOrder -> Val a -> TableOrder
    addVal [Text]
    prefix TableOrder
    to Val a
    lval =
        case Val a
    lval of
            ValArray a
    _ [Val a]
    xs -> (TableOrder -> Val a -> TableOrder)
    -> TableOrder -> [Val a] -> TableOrder
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([Text] -> TableOrder -> Val a -> TableOrder
    forall a. [Text] -> TableOrder -> Val a -> TableOrder
    addVal [Text]
    prefix) TableOrder
    to [Val a]
    xs
            ValTable a
    _ [(Key a, Val a)]
    kvs ->
                (TableOrder -> (Key a, Val a) -> TableOrder)
    -> TableOrder -> [(Key a, Val a)] -> TableOrder
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\TableOrder
    acc (Key a
    k,Val a
    v) ->
                    let k' :: [Text]
    k' = [Text]
    prefix [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ Key a -> [Text]
    forall a. Key a -> [Text]
    keyPath Key a
    k in
                    [Text] -> TableOrder -> Val a -> TableOrder
    forall a. [Text] -> TableOrder -> Val a -> TableOrder
    addVal [Text]
    k' (TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    acc [Text]
    k') Val a
    v) TableOrder
    to [(Key a, Val a)]
    kvs
            Val a
    _ -> TableOrder
    to

    addKey :: TableOrder -> [Text] -> TableOrder
    addKey :: TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    to [] = TableOrder
    to
    addKey (TO Map Text KeyOrder
    to) (Text
    x:[Text]
    xs) = Map Text KeyOrder -> TableOrder
    TO ((Maybe KeyOrder -> Maybe KeyOrder)
    -> Text -> Map Text KeyOrder -> Map Text KeyOrder
    forall k a.
    Ord k =>
    (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
    Map.alter Maybe KeyOrder -> Maybe KeyOrder
    f Text
    x Map Text KeyOrder
    to)
        where
            f :: Maybe KeyOrder -> Maybe KeyOrder
    f Maybe KeyOrder
    Nothing = KeyOrder -> Maybe KeyOrder
    forall a. a -> Maybe a
    Just (Int -> TableOrder -> KeyOrder
    KeyOrder (Map Text KeyOrder -> Int
    forall k a. Map k a -> Int
    Map.size Map Text KeyOrder
    to) (TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    emptyOrder [Text]
    xs))
            f (Just (KeyOrder Int
    i TableOrder
    m)) = KeyOrder -> Maybe KeyOrder
    forall a. a -> Maybe a
    Just (Int -> TableOrder -> KeyOrder
    KeyOrder Int
    i (TableOrder -> [Text] -> TableOrder
    addKey TableOrder
    m [Text]
    xs))

    keyPath :: Key a -> [Text]
    keyPath :: forall a. Key a -> [Text]
    keyPath = ((a, Text) -> Text) -> [(a, Text)] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Text) -> Text
    forall a b. (a, b) -> b
    snd ([(a, Text)] -> [Text])
    -> (Key a -> [(a, Text)]) -> Key a -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key a -> [(a, Text)]
    forall a. NonEmpty a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList

    -- | Render a white-space nested representation of the key ordering extracted
    -- by 'extractTableOrder'. This is provided for debugging and understandability.
    debugTableOrder :: TableOrder -> String
    debugTableOrder :: TableOrder -> String
    debugTableOrder TableOrder
    to = [String] -> String
    unlines (Int -> TableOrder -> [String] -> [String]
    go Int
    0 TableOrder
    to [])
        where
            go :: Int -> TableOrder -> [String] -> [String]
    go Int
    i (TO Map Text KeyOrder
    m) [String]
    z =
                ((Text, KeyOrder) -> [String] -> [String])
    -> [String] -> [(Text, KeyOrder)] -> [String]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Int -> (Text, KeyOrder) -> [String] -> [String]
    go1 Int
    i) [String]
    z
                    (((Text, KeyOrder) -> Int)
    -> [(Text, KeyOrder)] -> [(Text, KeyOrder)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (Text, KeyOrder) -> Int
    forall {a}. (a, KeyOrder) -> Int
    p (Map Text KeyOrder -> [(Text, KeyOrder)]
    forall k a. Map k a -> [(k, a)]
    Map.assocs Map Text KeyOrder
    m))

            go1 :: Int -> (Text, KeyOrder) -> [String] -> [String]
    go1 Int
    i (Text
    k, KeyOrder Int
    _ TableOrder
    v) [String]
    z =
                (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    4Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    i) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    Text.unpack Text
    k) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
                Int -> TableOrder -> [String] -> [String]
    go (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) TableOrder
    v [String]
    z

            p :: (a, KeyOrder) -> Int
    p (a
    _, KeyOrder Int
    i TableOrder
    _) = Int
    i