{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hpack.Render.Dsl (
-- * AST
  Element (..)
, Value (..)

-- * Render
, RenderSettings (..)
, CommaStyle (..)
, defaultRenderSettings
, Alignment (..)
, Nesting
, render

-- * Utils
, sortFieldsBy

#ifdef TEST
, Lines (..)
, renderValue
, addSortKey
#endif
) where

import           Imports

data Value =
    Literal String
  | CommaSeparatedList [String]
  | LineSeparatedList [String]
  | WordList [String]
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

data Element = Stanza String [Element] | Group Element Element | Field String Value | Verbatim String
  deriving (Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show)

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

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

newtype Nesting = Nesting Int
  deriving (Nesting -> Nesting -> Bool
(Nesting -> Nesting -> Bool)
-> (Nesting -> Nesting -> Bool) -> Eq Nesting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nesting -> Nesting -> Bool
$c/= :: Nesting -> Nesting -> Bool
== :: Nesting -> Nesting -> Bool
$c== :: Nesting -> Nesting -> Bool
Eq, Int -> Nesting -> ShowS
[Nesting] -> ShowS
Nesting -> String
(Int -> Nesting -> ShowS)
-> (Nesting -> String) -> ([Nesting] -> ShowS) -> Show Nesting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nesting] -> ShowS
$cshowList :: [Nesting] -> ShowS
show :: Nesting -> String
$cshow :: Nesting -> String
showsPrec :: Int -> Nesting -> ShowS
$cshowsPrec :: Int -> Nesting -> ShowS
Show, Integer -> Nesting
Nesting -> Nesting
Nesting -> Nesting -> Nesting
(Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Integer -> Nesting)
-> Num Nesting
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Nesting
$cfromInteger :: Integer -> Nesting
signum :: Nesting -> Nesting
$csignum :: Nesting -> Nesting
abs :: Nesting -> Nesting
$cabs :: Nesting -> Nesting
negate :: Nesting -> Nesting
$cnegate :: Nesting -> Nesting
* :: Nesting -> Nesting -> Nesting
$c* :: Nesting -> Nesting -> Nesting
- :: Nesting -> Nesting -> Nesting
$c- :: Nesting -> Nesting -> Nesting
+ :: Nesting -> Nesting -> Nesting
$c+ :: Nesting -> Nesting -> Nesting
Num, Int -> Nesting
Nesting -> Int
Nesting -> [Nesting]
Nesting -> Nesting
Nesting -> Nesting -> [Nesting]
Nesting -> Nesting -> Nesting -> [Nesting]
(Nesting -> Nesting)
-> (Nesting -> Nesting)
-> (Int -> Nesting)
-> (Nesting -> Int)
-> (Nesting -> [Nesting])
-> (Nesting -> Nesting -> [Nesting])
-> (Nesting -> Nesting -> [Nesting])
-> (Nesting -> Nesting -> Nesting -> [Nesting])
-> Enum Nesting
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nesting -> Nesting -> Nesting -> [Nesting]
$cenumFromThenTo :: Nesting -> Nesting -> Nesting -> [Nesting]
enumFromTo :: Nesting -> Nesting -> [Nesting]
$cenumFromTo :: Nesting -> Nesting -> [Nesting]
enumFromThen :: Nesting -> Nesting -> [Nesting]
$cenumFromThen :: Nesting -> Nesting -> [Nesting]
enumFrom :: Nesting -> [Nesting]
$cenumFrom :: Nesting -> [Nesting]
fromEnum :: Nesting -> Int
$cfromEnum :: Nesting -> Int
toEnum :: Int -> Nesting
$ctoEnum :: Int -> Nesting
pred :: Nesting -> Nesting
$cpred :: Nesting -> Nesting
succ :: Nesting -> Nesting
$csucc :: Nesting -> Nesting
Enum)

newtype Alignment = Alignment Int
  deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, Integer -> Alignment
Alignment -> Alignment
Alignment -> Alignment -> Alignment
(Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Alignment -> Alignment)
-> (Integer -> Alignment)
-> Num Alignment
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Alignment
$cfromInteger :: Integer -> Alignment
signum :: Alignment -> Alignment
$csignum :: Alignment -> Alignment
abs :: Alignment -> Alignment
$cabs :: Alignment -> Alignment
negate :: Alignment -> Alignment
$cnegate :: Alignment -> Alignment
* :: Alignment -> Alignment -> Alignment
$c* :: Alignment -> Alignment -> Alignment
- :: Alignment -> Alignment -> Alignment
$c- :: Alignment -> Alignment -> Alignment
+ :: Alignment -> Alignment -> Alignment
$c+ :: Alignment -> Alignment -> Alignment
Num)

data RenderSettings = RenderSettings {
  RenderSettings -> Int
renderSettingsIndentation :: Int
, RenderSettings -> Alignment
renderSettingsFieldAlignment :: Alignment
, RenderSettings -> CommaStyle
renderSettingsCommaStyle :: CommaStyle
} deriving (RenderSettings -> RenderSettings -> Bool
(RenderSettings -> RenderSettings -> Bool)
-> (RenderSettings -> RenderSettings -> Bool) -> Eq RenderSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderSettings -> RenderSettings -> Bool
$c/= :: RenderSettings -> RenderSettings -> Bool
== :: RenderSettings -> RenderSettings -> Bool
$c== :: RenderSettings -> RenderSettings -> Bool
Eq, Int -> RenderSettings -> ShowS
[RenderSettings] -> ShowS
RenderSettings -> String
(Int -> RenderSettings -> ShowS)
-> (RenderSettings -> String)
-> ([RenderSettings] -> ShowS)
-> Show RenderSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderSettings] -> ShowS
$cshowList :: [RenderSettings] -> ShowS
show :: RenderSettings -> String
$cshow :: RenderSettings -> String
showsPrec :: Int -> RenderSettings -> ShowS
$cshowsPrec :: Int -> RenderSettings -> ShowS
Show)

defaultRenderSettings :: RenderSettings
defaultRenderSettings :: RenderSettings
defaultRenderSettings = Int -> Alignment -> CommaStyle -> RenderSettings
RenderSettings Int
2 Alignment
0 CommaStyle
LeadingCommas

render :: RenderSettings -> Nesting -> Element -> [String]
render :: RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
nesting (Stanza String
name [Element]
elements) = RenderSettings -> Nesting -> ShowS
indent RenderSettings
settings Nesting
nesting String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: RenderSettings -> Nesting -> [Element] -> [String]
renderElements RenderSettings
settings (Nesting -> Nesting
forall a. Enum a => a -> a
succ Nesting
nesting) [Element]
elements
render RenderSettings
settings Nesting
nesting (Group Element
a Element
b) = RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
nesting Element
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
nesting Element
b
render RenderSettings
settings Nesting
nesting (Field String
name Value
value) = RenderSettings -> Nesting -> String -> Value -> [String]
renderField RenderSettings
settings Nesting
nesting String
name Value
value
render RenderSettings
settings Nesting
nesting (Verbatim String
str) = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (RenderSettings -> Nesting -> ShowS
indent RenderSettings
settings Nesting
nesting) (String -> [String]
lines String
str)

renderElements :: RenderSettings -> Nesting -> [Element] -> [String]
renderElements :: RenderSettings -> Nesting -> [Element] -> [String]
renderElements RenderSettings
settings Nesting
nesting = (Element -> [String]) -> [Element] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RenderSettings -> Nesting -> Element -> [String]
render RenderSettings
settings Nesting
nesting)

renderField :: RenderSettings -> Nesting -> String -> Value -> [String]
renderField :: RenderSettings -> Nesting -> String -> Value -> [String]
renderField settings :: RenderSettings
settings@RenderSettings{Int
Alignment
CommaStyle
renderSettingsCommaStyle :: CommaStyle
renderSettingsFieldAlignment :: Alignment
renderSettingsIndentation :: Int
renderSettingsCommaStyle :: RenderSettings -> CommaStyle
renderSettingsFieldAlignment :: RenderSettings -> Alignment
renderSettingsIndentation :: RenderSettings -> Int
..} Nesting
nesting String
name Value
value = case RenderSettings -> Value -> Lines
renderValue RenderSettings
settings Value
value of
  SingleLine String
"" -> []
  SingleLine String
x -> [RenderSettings -> Nesting -> ShowS
indent RenderSettings
settings Nesting
nesting (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
padding String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)]
  MultipleLines [] -> []
  MultipleLines [String]
xs -> (RenderSettings -> Nesting -> ShowS
indent RenderSettings
settings Nesting
nesting String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (RenderSettings -> Nesting -> ShowS
indent RenderSettings
settings (Nesting -> ShowS) -> Nesting -> ShowS
forall a b. (a -> b) -> a -> b
$ Nesting -> Nesting
forall a. Enum a => a -> a
succ Nesting
nesting) [String]
xs
  where
    Alignment Int
fieldAlignment = Alignment
renderSettingsFieldAlignment
    padding :: String
padding = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
fieldAlignment Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Char
' '

renderValue :: RenderSettings -> Value -> Lines
renderValue :: RenderSettings -> Value -> Lines
renderValue RenderSettings{Int
Alignment
CommaStyle
renderSettingsCommaStyle :: CommaStyle
renderSettingsFieldAlignment :: Alignment
renderSettingsIndentation :: Int
renderSettingsCommaStyle :: RenderSettings -> CommaStyle
renderSettingsFieldAlignment :: RenderSettings -> Alignment
renderSettingsIndentation :: RenderSettings -> Int
..} Value
v = case Value
v of
  Literal String
s -> String -> Lines
SingleLine String
s
  WordList [String]
ws -> String -> Lines
SingleLine (String -> Lines) -> String -> Lines
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
ws
  LineSeparatedList [String]
xs -> CommaStyle -> [String] -> Lines
renderLineSeparatedList CommaStyle
renderSettingsCommaStyle [String]
xs
  CommaSeparatedList [String]
xs -> CommaStyle -> [String] -> Lines
renderCommaSeparatedList CommaStyle
renderSettingsCommaStyle [String]
xs

renderLineSeparatedList :: CommaStyle -> [String] -> Lines
renderLineSeparatedList :: CommaStyle -> [String] -> Lines
renderLineSeparatedList CommaStyle
style = [String] -> Lines
MultipleLines ([String] -> Lines) -> ([String] -> [String]) -> [String] -> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
padding String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  where
    padding :: String
padding = case CommaStyle
style of
      CommaStyle
LeadingCommas -> String
"  "
      CommaStyle
TrailingCommas -> String
""

renderCommaSeparatedList :: CommaStyle -> [String] -> Lines
renderCommaSeparatedList :: CommaStyle -> [String] -> Lines
renderCommaSeparatedList CommaStyle
style = [String] -> Lines
MultipleLines ([String] -> Lines) -> ([String] -> [String]) -> [String] -> Lines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case CommaStyle
style of
  CommaStyle
LeadingCommas -> ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, String) -> String
renderLeadingComma ([(Bool, String)] -> [String])
-> ([String] -> [(Bool, String)]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [String] -> [(Bool, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
  CommaStyle
TrailingCommas -> ((Bool, String) -> String) -> [(Bool, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, String) -> String
renderTrailingComma ([(Bool, String)] -> [String])
-> ([String] -> [(Bool, String)]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bool, String)] -> [(Bool, String)]
forall a. [a] -> [a]
reverse ([(Bool, String)] -> [(Bool, String)])
-> ([String] -> [(Bool, String)]) -> [String] -> [(Bool, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [String] -> [(Bool, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) ([String] -> [(Bool, String)])
-> ([String] -> [String]) -> [String] -> [(Bool, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
  where
    renderLeadingComma :: (Bool, String) -> String
    renderLeadingComma :: (Bool, String) -> String
renderLeadingComma (Bool
isFirst, String
x)
      | Bool
isFirst   = String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
      | Bool
otherwise = String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

    renderTrailingComma :: (Bool, String) -> String
    renderTrailingComma :: (Bool, String) -> String
renderTrailingComma (Bool
isLast, String
x)
      | Bool
isLast    = String
x
      | Bool
otherwise = String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
","

instance IsString Value where
  fromString :: String -> Value
fromString = String -> Value
Literal

indent :: RenderSettings -> Nesting -> String -> String
indent :: RenderSettings -> Nesting -> ShowS
indent RenderSettings{Int
Alignment
CommaStyle
renderSettingsCommaStyle :: CommaStyle
renderSettingsFieldAlignment :: Alignment
renderSettingsIndentation :: Int
renderSettingsCommaStyle :: RenderSettings -> CommaStyle
renderSettingsFieldAlignment :: RenderSettings -> Alignment
renderSettingsIndentation :: RenderSettings -> Int
..} (Nesting Int
nesting) String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nesting Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
renderSettingsIndentation) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

sortFieldsBy :: [String] -> [Element] -> [Element]
sortFieldsBy :: [String] -> [Element] -> [Element]
sortFieldsBy [String]
existingFieldOrder =
    (((Int, Int), Element) -> Element)
-> [((Int, Int), Element)] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), Element) -> Element
forall a b. (a, b) -> b
snd
  ([((Int, Int), Element)] -> [Element])
-> ([Element] -> [((Int, Int), Element)]) -> [Element] -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Int), Element) -> (Int, Int))
-> [((Int, Int), Element)] -> [((Int, Int), Element)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Int, Int), Element) -> (Int, Int)
forall a b. (a, b) -> a
fst
  ([((Int, Int), Element)] -> [((Int, Int), Element)])
-> ([Element] -> [((Int, Int), Element)])
-> [Element]
-> [((Int, Int), Element)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe Int, Element)] -> [((Int, Int), Element)]
forall a. [(Maybe Int, a)] -> [((Int, Int), a)]
addSortKey
  ([(Maybe Int, Element)] -> [((Int, Int), Element)])
-> ([Element] -> [(Maybe Int, Element)])
-> [Element]
-> [((Int, Int), Element)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> (Maybe Int, Element))
-> [Element] -> [(Maybe Int, Element)]
forall a b. (a -> b) -> [a] -> [b]
map (\Element
a -> (Element -> Maybe Int
existingIndex Element
a, Element
a))
  where
    existingIndex :: Element -> Maybe Int
    existingIndex :: Element -> Maybe Int
existingIndex (Field String
name Value
_) = String
name String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [String]
existingFieldOrder
    existingIndex Element
_ = Maybe Int
forall a. Maybe a
Nothing

addSortKey :: [(Maybe Int, a)] -> [((Int, Int), a)]
addSortKey :: [(Maybe Int, a)] -> [((Int, Int), a)]
addSortKey = Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
forall a. Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
go (-Int
1) ([(Int, (Maybe Int, a))] -> [((Int, Int), a)])
-> ([(Maybe Int, a)] -> [(Int, (Maybe Int, a))])
-> [(Maybe Int, a)]
-> [((Int, Int), a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Maybe Int, a)] -> [(Int, (Maybe Int, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
  where
    go :: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
    go :: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
go Int
n [(Int, (Maybe Int, a))]
xs = case [(Int, (Maybe Int, a))]
xs of
      [] -> []
      (Int
x, (Just Int
y, a
a)) : [(Int, (Maybe Int, a))]
ys -> ((Int
y, Int
x), a
a) ((Int, Int), a) -> [((Int, Int), a)] -> [((Int, Int), a)]
forall a. a -> [a] -> [a]
: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
forall a. Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
go Int
y [(Int, (Maybe Int, a))]
ys
      (Int
x, (Maybe Int
Nothing, a
a)) : [(Int, (Maybe Int, a))]
ys -> ((Int
n, Int
x), a
a) ((Int, Int), a) -> [((Int, Int), a)] -> [((Int, Int), a)]
forall a. a -> [a] -> [a]
: Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
forall a. Int -> [(Int, (Maybe Int, a))] -> [((Int, Int), a)]
go Int
n [(Int, (Maybe Int, a))]
ys