{-|
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)
@

@since 1.3.1.0

-}
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 Toml.Located (Located(locThing))
import Toml.Parser.Types (Expr(..), Key, Val(ValTable, ValArray))

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

data KeyOrder = KeyOrder !Int TableOrder

newtype ProjectedKey = PK (Either Int String)
    deriving (ProjectedKey -> ProjectedKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectedKey -> ProjectedKey -> Bool
$c/= :: ProjectedKey -> ProjectedKey -> Bool
== :: ProjectedKey -> ProjectedKey -> Bool
$c== :: ProjectedKey -> ProjectedKey -> Bool
Eq, Eq 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
min :: ProjectedKey -> ProjectedKey -> ProjectedKey
$cmin :: ProjectedKey -> ProjectedKey -> ProjectedKey
max :: ProjectedKey -> ProjectedKey -> ProjectedKey
$cmax :: ProjectedKey -> ProjectedKey -> ProjectedKey
>= :: ProjectedKey -> ProjectedKey -> Bool
$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
compare :: ProjectedKey -> ProjectedKey -> Ordering
$ccompare :: ProjectedKey -> ProjectedKey -> Ordering
Ord)

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

emptyOrder :: TableOrder
emptyOrder :: TableOrder
emptyOrder = Map String KeyOrder -> TableOrder
TO 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] -> TableOrder
extractTableOrder :: [Expr] -> TableOrder
extractTableOrder = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([String], TableOrder) -> Expr -> ([String], TableOrder)
addExpr ([], TableOrder
emptyOrder)

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

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

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

keyPath :: Key -> [String]
keyPath :: Key -> [String]
keyPath = forall a b. (a -> b) -> [a] -> [b]
map forall a. Located a -> a
locThing forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 String KeyOrder
m) [String]
z =
            forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> (String, KeyOrder) -> [String] -> [String]
go1 Int
i) [String]
z
                (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall {a}. (a, KeyOrder) -> Int
p (forall k a. Map k a -> [(k, a)]
Map.assocs Map String KeyOrder
m))

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

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