{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-dodgy-exports -fno-warn-duplicate-exports #-}

module Autodocodec.Nix.Expression
  ( Expression (..),
    Expr,
    renderExpression,
    renderExpr,
    jsonValueExpression,
    jsonObjectExpression,
  )
where

import Data.Aeson as JSON
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V

-- For backward compatibility
-- {-# DEPRECATED "Use Expression instead" #-}
type Expr = Expression

data Expression
  = ExprNull
  | ExprLitBool !Bool
  | ExprLitString !Text
  | ExprLitNumber !Scientific
  | ExprLitList ![Expression]
  | ExprVar !Text
  | ExprAttrSet !(Map Text Expression)
  | ExprAp !Expression !Expression
  | ExprFun ![Text] !Expression
  | ExprWith !Text !Expression
  deriving (Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> String
show :: Expression -> String
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show, Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
/= :: Expression -> Expression -> Bool
Eq, Eq Expression
Eq Expression =>
(Expression -> Expression -> Ordering)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Expression)
-> (Expression -> Expression -> Expression)
-> Ord Expression
Expression -> Expression -> Bool
Expression -> Expression -> Ordering
Expression -> Expression -> Expression
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 :: Expression -> Expression -> Ordering
compare :: Expression -> Expression -> Ordering
$c< :: Expression -> Expression -> Bool
< :: Expression -> Expression -> Bool
$c<= :: Expression -> Expression -> Bool
<= :: Expression -> Expression -> Bool
$c> :: Expression -> Expression -> Bool
> :: Expression -> Expression -> Bool
$c>= :: Expression -> Expression -> Bool
>= :: Expression -> Expression -> Bool
$cmax :: Expression -> Expression -> Expression
max :: Expression -> Expression -> Expression
$cmin :: Expression -> Expression -> Expression
min :: Expression -> Expression -> Expression
Ord)

-- {-# DEPRECATED renderExpr "Use renderExpression instead" #-}
renderExpr :: Expr -> Text
renderExpr :: Expression -> Text
renderExpr = Expression -> Text
renderExpression

renderExpression :: Expr -> Text
renderExpression :: Expression -> Text
renderExpression = [Text] -> Text
T.unlines ([Text] -> Text) -> (Expression -> [Text]) -> Expression -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expression -> [Text]
go Int
0
  where
    parensWhen :: Bool -> [Text] -> [Text]
parensWhen Bool
b [Text]
ts = if Bool
b then [Text] -> [Text]
parens [Text]
ts else [Text]
ts
    go :: Int -> Expr -> [Text]
    go :: Int -> Expression -> [Text]
go Int
d = \case
      Expression
ExprNull -> [Text
"null"]
      ExprLitBool Bool
b -> [if Bool
b then Text
"true" else Text
"false"]
      ExprLitString Text
s -> [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s]
      ExprLitNumber Scientific
s ->
        [ case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
s of
            Left Double
f -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show (Double
f :: Double)
            Right Integer
i -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer
i :: Integer)
        ]
      ExprLitList [Expression]
es -> case [Expression]
es of
        [] -> [Text
"[]"]
        [Expression
e] -> Text -> Text -> [Text] -> [Text]
surround Text
"[" Text
"]" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Expression -> [Text]
go Int
0 Expression
e
        [Expression]
_ ->
          -- If there is more than one list element, put them on separate lines.
          Text
"[" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
indent ((Expression -> [Text]) -> [Expression] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Expression -> [Text]
go Int
11) [Expression]
es) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"]"]
      ExprVar Text
s -> [Text
s]
      ExprAttrSet Map Text Expression
m | Map Text Expression -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Expression
m -> [Text
"{ }"]
      ExprAttrSet Map Text Expression
m ->
        -- We always put "{" and "}" on separate lines.
        Text
"{" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
indent (((Text, Expression) -> [Text]) -> [(Text, Expression)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> Expression -> [Text]) -> (Text, Expression) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expression -> [Text]
goBind) (Map Text Expression -> [(Text, Expression)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Expression
m)) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"}"]
      ExprAp Expression
e1 Expression
e2 ->
        Bool -> [Text] -> [Text]
parensWhen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
          Int -> Expression -> [Text]
go Int
11 Expression
e1 [Text] -> [Text] -> [Text]
`apply` Int -> Expression -> [Text]
go Int
11 Expression
e2
      ExprFun [Text]
args Expression
e ->
        Bool -> [Text] -> [Text]
parensWhen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
          Text -> Text -> Text -> [Text] -> [Text]
surroundWith Text
" " Text
"{" Text
"}:" [Text -> [Text] -> Text
T.intercalate Text
", " [Text]
args]
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> Expression -> [Text]
go Int
0 Expression
e
      ExprWith Text
t Expression
e ->
        Bool -> [Text] -> [Text]
parensWhen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
          (Text
"with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Expression -> [Text]
go Int
0 Expression
e
    goBind :: Text -> Expression -> [Text]
goBind Text
key Expression
e =
      Text -> Text -> [Text] -> [Text]
prependWith Text
" " (Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" =") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        ([Text] -> Text -> [Text]
`append` Text
";") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
          Int -> Expression -> [Text]
go Int
0 Expression
e

indent :: [Text] -> [Text]
indent :: [Text] -> [Text]
indent = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

prependWith :: Text -> Text -> [Text] -> [Text]
prependWith :: Text -> Text -> [Text] -> [Text]
prependWith Text
spacer Text
t = \case
  [] -> [Text
t]
  (Text
u : [Text]
us) -> (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
us

append :: [Text] -> Text -> [Text]
append :: [Text] -> Text -> [Text]
append = Text -> [Text] -> Text -> [Text]
appendWith Text
T.empty

appendWith :: Text -> [Text] -> Text -> [Text]
appendWith :: Text -> [Text] -> Text -> [Text]
appendWith Text
spacer [Text]
ts Text
u = [Text] -> [Text]
go [Text]
ts
  where
    go :: [Text] -> [Text]
go = \case
      [] -> [Text
u]
      [Text
t] -> [Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
spacer Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u]
      (Text
t : [Text]
ts') -> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ts'

apply :: [Text] -> [Text] -> [Text]
apply :: [Text] -> [Text] -> [Text]
apply [Text]
ts1 [Text]
ts2 = case ([Text]
ts1, [Text]
ts2) of
  ([Text
t1], [Text
t2]) -> [Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2]
  ([Text
t1], [Text]
_) -> Text -> Text -> [Text] -> [Text]
prependWith Text
" " Text
t1 [Text]
ts2
  ([Text]
_, [Text
t2]) -> [Text]
ts1 [Text] -> Text -> [Text]
`append` Text
t2
  ([Text], [Text])
_ -> [Text] -> [Text]
go [Text]
ts1
    where
      go :: [Text] -> [Text]
go = \case
        [] -> [Text]
ts2
        [Text
t] -> Text -> Text -> [Text] -> [Text]
prependWith Text
" " Text
t [Text]
ts2
        (Text
t : [Text]
ts) -> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ts

parens :: [Text] -> [Text]
parens :: [Text] -> [Text]
parens = Text -> Text -> [Text] -> [Text]
surround Text
"(" Text
")"

surround :: Text -> Text -> [Text] -> [Text]
surround :: Text -> Text -> [Text] -> [Text]
surround = Text -> Text -> Text -> [Text] -> [Text]
surroundWith Text
T.empty

surroundWith :: Text -> Text -> Text -> [Text] -> [Text]
surroundWith :: Text -> Text -> Text -> [Text] -> [Text]
surroundWith Text
spacer Text
open Text
close = Text -> Text -> [Text] -> [Text]
prependWith Text
spacer Text
open ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Text]
t -> Text -> [Text] -> Text -> [Text]
appendWith Text
spacer [Text]
t Text
close)

jsonValueExpression :: JSON.Value -> Expression
jsonValueExpression :: Value -> Expression
jsonValueExpression = Value -> Expression
go
  where
    go :: Value -> Expression
go = \case
      Value
JSON.Null -> Expression
ExprNull
      JSON.Bool Bool
b -> Bool -> Expression
ExprLitBool Bool
b
      JSON.String Text
s -> Text -> Expression
ExprLitString Text
s
      JSON.Number Scientific
n -> Scientific -> Expression
ExprLitNumber Scientific
n
      JSON.Array Array
v -> [Expression] -> Expression
ExprLitList ([Expression] -> Expression) -> [Expression] -> Expression
forall a b. (a -> b) -> a -> b
$ (Value -> Expression) -> [Value] -> [Expression]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Expression
go ([Value] -> [Expression]) -> [Value] -> [Expression]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v
      JSON.Object Object
vs -> Map Text Expression -> Expression
ExprAttrSet (Map Text Expression -> Expression)
-> Map Text Expression -> Expression
forall a b. (a -> b) -> a -> b
$ Object -> Map Text Expression
jsonObjectExpression Object
vs

jsonObjectExpression :: JSON.Object -> Map Text Expression
jsonObjectExpression :: Object -> Map Text Expression
jsonObjectExpression = (Key -> Text) -> Map Key Expression -> Map Text Expression
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic Key -> Text
Key.toText (Map Key Expression -> Map Text Expression)
-> (Object -> Map Key Expression) -> Object -> Map Text Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Expression -> Map Key Expression
forall v. KeyMap v -> Map Key v
KeyMap.toMap (KeyMap Expression -> Map Key Expression)
-> (Object -> KeyMap Expression) -> Object -> Map Key Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Expression) -> Object -> KeyMap Expression
forall a b. (a -> b) -> KeyMap a -> KeyMap b
KeyMap.map Value -> Expression
jsonValueExpression