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

module Autodocodec.Nix
  ( -- * Producing a Nixos module type
    renderNixOptionTypeViaCodec,
    renderNixOptionsViaCodec,
    renderNixOptionTypeVia,
    renderNixOptionsVia,
    valueCodecNixOptionType,
    objectCodecNixOptions,
    Option (..),
    OptionType (..),
    renderOption,
    renderOptionType,
    optionExpr,
    optionsExpr,
    optionTypeExpr,
    renderExpr,

    -- * To makes sure we definitely export everything.
    module Autodocodec.Nix,
  )
where

import Autodocodec
import Control.Applicative
import Data.Aeson as JSON
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Containers.ListUtils
import qualified Data.HashMap.Strict as HM
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V

renderNixOptionTypeViaCodec :: forall a. (HasCodec a) => Text
renderNixOptionTypeViaCodec :: forall a. HasCodec a => Text
renderNixOptionTypeViaCodec = ValueCodec a a -> Text
forall input output. ValueCodec input output -> Text
renderNixOptionTypeVia (forall value. HasCodec value => JSONCodec value
codec @a)

renderNixOptionsViaCodec :: forall a. (HasObjectCodec a) => Text
renderNixOptionsViaCodec :: forall a. HasObjectCodec a => Text
renderNixOptionsViaCodec = ObjectCodec a a -> Text
forall input output. ObjectCodec input output -> Text
renderNixOptionsVia (forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec @a)

renderNixOptionTypeVia :: ValueCodec input output -> Text
renderNixOptionTypeVia :: forall input output. ValueCodec input output -> Text
renderNixOptionTypeVia =
  OptionType -> Text
renderOptionType
    (OptionType -> Text)
-> (ValueCodec input output -> OptionType)
-> ValueCodec input output
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionType -> Maybe OptionType -> OptionType
forall a. a -> Maybe a -> a
fromMaybe (Text -> OptionType
OptionTypeSimple Text
"lib.types.anything")
    (Maybe OptionType -> OptionType)
-> (ValueCodec input output -> Maybe OptionType)
-> ValueCodec input output
-> OptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCodec input output -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType

renderNixOptionsVia :: ObjectCodec input output -> Text
renderNixOptionsVia :: forall input output. ObjectCodec input output -> Text
renderNixOptionsVia =
  Map Text Option -> Text
renderOptions
    (Map Text Option -> Text)
-> (ObjectCodec input output -> Map Text Option)
-> ObjectCodec input output
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectCodec input output -> Map Text Option
forall input output. ObjectCodec input output -> Map Text Option
objectCodecNixOptions

valueCodecNixOptionType :: ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType :: forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType = (OptionType -> OptionType) -> Maybe OptionType -> Maybe OptionType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OptionType -> OptionType
simplifyOptionType (Maybe OptionType -> Maybe OptionType)
-> (ValueCodec input output -> Maybe OptionType)
-> ValueCodec input output
-> Maybe OptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueCodec input output -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go
  where
    mTyp :: Maybe OptionType -> OptionType
mTyp = OptionType -> Maybe OptionType -> OptionType
forall a. a -> Maybe a -> a
fromMaybe (OptionType -> Maybe OptionType -> OptionType)
-> OptionType -> Maybe OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ Text -> OptionType
OptionTypeSimple Text
"lib.types.anything"
    go :: ValueCodec input output -> Maybe OptionType
    go :: forall input output. ValueCodec input output -> Maybe OptionType
go = \case
      ValueCodec input output
NullCodec -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just OptionType
OptionTypeNull
      BoolCodec Maybe Text
_ -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ Text -> OptionType
OptionTypeSimple Text
"lib.types.bool"
      StringCodec Maybe Text
_ -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ Text -> OptionType
OptionTypeSimple Text
"lib.types.str"
      IntegerCodec Maybe Text
_ Bounds Integer
bounds -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$
        Text -> OptionType
OptionTypeSimple (Text -> OptionType) -> Text -> OptionType
forall a b. (a -> b) -> a -> b
$
          case Bounds Integer -> IntegerBoundsSymbolic
guessIntegerBoundsSymbolic Bounds Integer
bounds of
            BitUInt Word8
w -> case Word8
w of
              Word8
64 -> Text
"lib.types.ints.unsigned"
              Word8
32 -> Text
"lib.types.ints.u32"
              Word8
16 -> Text
"lib.types.ints.u16"
              Word8
8 -> Text
"lib.types.ints.u8"
              Word8
_ -> Text
"lib.types.int" -- TODO bounds?
            BitSInt Word8
w -> case Word8
w of
              Word8
64 -> Text
"lib.types.int"
              Word8
32 -> Text
"lib.types.ints.s32"
              Word8
16 -> Text
"lib.types.ints.s16"
              Word8
8 -> Text
"lib.types.ints.s8"
              Word8
_ -> Text
"lib.types.int" -- TODO bounds?
            OtherIntegerBounds Maybe IntegerSymbolic
_ Maybe IntegerSymbolic
_ -> Text
"lib.types.int" -- TODO bounds?
      NumberCodec Maybe Text
_ Bounds Scientific
_ -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ Text -> OptionType
OptionTypeSimple Text
"lib.types.number"
      HashMapCodec JSONCodec v
c -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
OptionTypeAttrsOf (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ Maybe OptionType -> OptionType
mTyp (Maybe OptionType -> OptionType) -> Maybe OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ JSONCodec v -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go JSONCodec v
c
      MapCodec JSONCodec v
c -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
OptionTypeAttrsOf (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ Maybe OptionType -> OptionType
mTyp (Maybe OptionType -> OptionType) -> Maybe OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ JSONCodec v -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go JSONCodec v
c
      ValueCodec input output
ValueCodec -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (Text -> OptionType
OptionTypeSimple Text
"lib.types.unspecified")
      ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
c -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
OptionTypeListOf (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ Maybe OptionType -> OptionType
mTyp (Maybe OptionType -> OptionType) -> Maybe OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ ValueCodec input1 output1 -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go ValueCodec input1 output1
c
      ObjectOfCodec Maybe Text
_ ObjectCodec input output
oc -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (Map Text Option -> OptionType
OptionTypeSubmodule (ObjectCodec input output -> Map Text Option
forall input output. ObjectCodec input output -> Map Text Option
objectCodecNixOptions ObjectCodec input output
oc))
      EqCodec value
v JSONCodec value
c -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ [Expr] -> OptionType
OptionTypeEnum [Value -> Expr
jsonValueExpr (Value -> Expr) -> Value -> Expr
forall a b. (a -> b) -> a -> b
$ JSONCodec value -> value -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia JSONCodec value
c value
v]
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec Value oldInput oldOutput
c -> Codec Value oldInput oldOutput -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go Codec Value oldInput oldOutput
c
      EitherCodec Union
_ Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ [OptionType] -> OptionType
OptionTypeOneOf ((Maybe OptionType -> OptionType)
-> [Maybe OptionType] -> [OptionType]
forall a b. (a -> b) -> [a] -> [b]
map Maybe OptionType -> OptionType
mTyp [Codec Value input1 output1 -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go Codec Value input1 output1
c1, Codec Value input2 output2 -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go Codec Value input2 output2
c2])
      CommentCodec Text
_ ValueCodec input output
c -> ValueCodec input output -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
go ValueCodec input output
c
      ReferenceCodec {} -> Maybe OptionType
forall a. Maybe a
Nothing -- TODO: let-binding?

-- [tag:NixOptionNullable]
-- Note about nullable options:
-- It's not technically accurate to represent optional fields as the 'null' value in Nix,
-- but Nix isn't very good at optional values at all, so we use 'null' for both
-- optional fields and nullable fields.
-- If Nix options ever figure out how to do optional fields, we'll use that
-- instead.
objectCodecNixOptions :: ObjectCodec input output -> Map Text Option
objectCodecNixOptions :: forall input output. ObjectCodec input output -> Map Text Option
objectCodecNixOptions = Map Text Option -> Map Text Option
simplifyOptions (Map Text Option -> Map Text Option)
-> (ObjectCodec input output -> Map Text Option)
-> ObjectCodec input output
-> Map Text Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ObjectCodec input output -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
False
  where
    -- The bool means 'force optional'
    go :: Bool -> ObjectCodec input output -> Map Text Option
    go :: forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
b = \case
      DiscriminatedUnionCodec Text
k input -> (Text, ObjectCodec input ())
_ HashMap Text (Text, ObjectCodec Void output)
m ->
        Text -> Option -> Map Text Option -> Map Text Option
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
          Text
k
          ( Option
              { optionType :: Maybe OptionType
optionType = OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ [OptionType] -> OptionType
OptionTypeOneOf ([OptionType] -> OptionType) -> [OptionType] -> OptionType
forall a b. (a -> b) -> a -> b
$ (Text -> OptionType) -> [Text] -> [OptionType]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> OptionType
OptionTypeSimple (Text -> OptionType) -> (Text -> Text) -> Text -> OptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) ([Text] -> [OptionType]) -> [Text] -> [OptionType]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Text, ObjectCodec Void output) -> [Text]
forall k v. HashMap k v -> [k]
HM.keys HashMap Text (Text, ObjectCodec Void output)
m,
                optionDescription :: Maybe Text
optionDescription = Maybe Text
forall a. Maybe a
Nothing,
                optionDefault :: Maybe Value
optionDefault = Maybe Value
forall a. Maybe a
Nothing
              }
          )
          (Map Text Option -> Map Text Option)
-> Map Text Option -> Map Text Option
forall a b. (a -> b) -> a -> b
$ (Option -> Option -> Option)
-> [Map Text Option] -> Map Text Option
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith
            ( \Option
t1 Option
t2 ->
                Option
                  { optionType :: Maybe OptionType
optionType = OptionType -> Maybe OptionType
forall a. a -> Maybe a
Just (OptionType -> Maybe OptionType) -> OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ [OptionType] -> OptionType
OptionTypeOneOf ([OptionType] -> OptionType) -> [OptionType] -> OptionType
forall a b. (a -> b) -> a -> b
$ (Option -> OptionType) -> [Option] -> [OptionType]
forall a b. (a -> b) -> [a] -> [b]
map (OptionType -> Maybe OptionType -> OptionType
forall a. a -> Maybe a -> a
fromMaybe (Text -> OptionType
OptionTypeSimple Text
"lib.types.anything") (Maybe OptionType -> OptionType)
-> (Option -> Maybe OptionType) -> Option -> OptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Maybe OptionType
optionType) [Option
t1, Option
t2],
                    optionDescription :: Maybe Text
optionDescription = Option -> Maybe Text
optionDescription Option
t1 Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Option -> Maybe Text
optionDescription Option
t2, -- TODO
                    optionDefault :: Maybe Value
optionDefault = Maybe Value
forall a. Maybe a
Nothing
                  }
            )
          ([Map Text Option] -> Map Text Option)
-> [Map Text Option] -> Map Text Option
forall a b. (a -> b) -> a -> b
$ ((Text, ObjectCodec Void output) -> Map Text Option)
-> [(Text, ObjectCodec Void output)] -> [Map Text Option]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ObjectCodec Void output -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
b (ObjectCodec Void output -> Map Text Option)
-> ((Text, ObjectCodec Void output) -> ObjectCodec Void output)
-> (Text, ObjectCodec Void output)
-> Map Text Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, ObjectCodec Void output) -> ObjectCodec Void output
forall a b. (a, b) -> b
snd)
          ([(Text, ObjectCodec Void output)] -> [Map Text Option])
-> [(Text, ObjectCodec Void output)] -> [Map Text Option]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Text, ObjectCodec Void output)
-> [(Text, ObjectCodec Void output)]
forall k v. HashMap k v -> [v]
HM.elems HashMap Text (Text, ObjectCodec Void output)
m
      RequiredKeyCodec Text
key ValueCodec input output
o Maybe Text
mDesc ->
        Text -> Option -> Map Text Option
forall k a. k -> a -> Map k a
M.singleton Text
key (Option -> Map Text Option) -> Option -> Map Text Option
forall a b. (a -> b) -> a -> b
$
          Option
            { optionType :: Maybe OptionType
optionType =
                ( if Bool
b
                    then (OptionType -> OptionType) -> Maybe OptionType -> Maybe OptionType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OptionType -> OptionType
OptionTypeNullOr
                    else Maybe OptionType -> Maybe OptionType
forall a. a -> a
id
                )
                  (Maybe OptionType -> Maybe OptionType)
-> Maybe OptionType -> Maybe OptionType
forall a b. (a -> b) -> a -> b
$ ValueCodec input output -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType ValueCodec input output
o,
              optionDescription :: Maybe Text
optionDescription = Maybe Text
mDesc,
              optionDefault :: Maybe Value
optionDefault =
                if Bool
b
                  then Value -> Maybe Value
forall a. a -> Maybe a
Just Value
JSON.Null
                  else Maybe Value
forall a. Maybe a
Nothing -- [ref:NixOptionNullable]
            }
      OptionalKeyCodec Text
key ValueCodec input1 output1
o Maybe Text
mDesc ->
        Text -> Option -> Map Text Option
forall k a. k -> a -> Map k a
M.singleton Text
key (Option -> Map Text Option) -> Option -> Map Text Option
forall a b. (a -> b) -> a -> b
$
          Option
            { optionType :: Maybe OptionType
optionType = OptionType -> OptionType
OptionTypeNullOr (OptionType -> OptionType) -> Maybe OptionType -> Maybe OptionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueCodec input1 output1 -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType ValueCodec input1 output1
o,
              optionDescription :: Maybe Text
optionDescription = Maybe Text
mDesc,
              optionDefault :: Maybe Value
optionDefault = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
JSON.Null -- [ref:NixOptionNullable]
            }
      OptionalKeyWithDefaultCodec Text
key ValueCodec input input
c input
defaultValue Maybe Text
mDesc ->
        Text -> Option -> Map Text Option
forall k a. k -> a -> Map k a
M.singleton
          Text
key
          Option
            { optionType :: Maybe OptionType
optionType = ValueCodec input input -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType ValueCodec input input
c,
              optionDescription :: Maybe Text
optionDescription = Maybe Text
mDesc,
              optionDefault :: Maybe Value
optionDefault = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ValueCodec input input -> input -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec input input
c input
defaultValue
            }
      OptionalKeyWithOmittedDefaultCodec Text
key ValueCodec value value
c value
defaultValue Maybe Text
mDesc ->
        Text -> Option -> Map Text Option
forall k a. k -> a -> Map k a
M.singleton
          Text
key
          Option
            { optionType :: Maybe OptionType
optionType = ValueCodec value value -> Maybe OptionType
forall input output. ValueCodec input output -> Maybe OptionType
valueCodecNixOptionType ValueCodec value value
c,
              optionDescription :: Maybe Text
optionDescription = Maybe Text
mDesc,
              optionDefault :: Maybe Value
optionDefault = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ValueCodec value value -> value -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec value value
c value
defaultValue
            }
      PureCodec output
_ -> Map Text Option
forall k a. Map k a
M.empty
      ApCodec ObjectCodec input (output1 -> output)
c1 ObjectCodec input output1
c2 -> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Bool -> ObjectCodec input (output1 -> output) -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
b ObjectCodec input (output1 -> output)
c1) (Bool -> ObjectCodec input output1 -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
b ObjectCodec input output1
c2)
      BimapCodec oldOutput -> Either String output
_ input -> oldInput
_ Codec Object oldInput oldOutput
c -> Bool -> Codec Object oldInput oldOutput -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
b Codec Object oldInput oldOutput
c
      EitherCodec Union
_ Codec Object input1 output1
c1 Codec Object input2 output2
c2 -> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Bool -> Codec Object input1 output1 -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
True Codec Object input1 output1
c1) (Bool -> Codec Object input2 output2 -> Map Text Option
forall input output.
Bool -> ObjectCodec input output -> Map Text Option
go Bool
True Codec Object input2 output2
c2) -- TODO use a more accurate or?

data Option = Option
  { Option -> Maybe OptionType
optionType :: !(Maybe OptionType),
    Option -> Maybe Text
optionDescription :: !(Maybe Text),
    Option -> Maybe Value
optionDefault :: !(Maybe JSON.Value)
  }
  deriving (Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Option -> ShowS
showsPrec :: Int -> Option -> ShowS
$cshow :: Option -> String
show :: Option -> String
$cshowList :: [Option] -> ShowS
showList :: [Option] -> ShowS
Show, Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
/= :: Option -> Option -> Bool
Eq, Eq Option
Eq Option =>
(Option -> Option -> Ordering)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Option)
-> (Option -> Option -> Option)
-> Ord Option
Option -> Option -> Bool
Option -> Option -> Ordering
Option -> Option -> Option
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 :: Option -> Option -> Ordering
compare :: Option -> Option -> Ordering
$c< :: Option -> Option -> Bool
< :: Option -> Option -> Bool
$c<= :: Option -> Option -> Bool
<= :: Option -> Option -> Bool
$c> :: Option -> Option -> Bool
> :: Option -> Option -> Bool
$c>= :: Option -> Option -> Bool
>= :: Option -> Option -> Bool
$cmax :: Option -> Option -> Option
max :: Option -> Option -> Option
$cmin :: Option -> Option -> Option
min :: Option -> Option -> Option
Ord)

emptyOption :: Option
emptyOption :: Option
emptyOption =
  Option
    { optionType :: Maybe OptionType
optionType = Maybe OptionType
forall a. Maybe a
Nothing,
      optionDescription :: Maybe Text
optionDescription = Maybe Text
forall a. Maybe a
Nothing,
      optionDefault :: Maybe Value
optionDefault = Maybe Value
forall a. Maybe a
Nothing
    }

simplifyOption :: Option -> Option
simplifyOption :: Option -> Option
simplifyOption Option
o = Option
o {optionType = simplifyOptionType <$> optionType o}

data OptionType
  = OptionTypeNull
  | OptionTypeSimple !Text
  | OptionTypeEnum ![Expr]
  | OptionTypeNullOr !OptionType
  | OptionTypeListOf !OptionType
  | OptionTypeAttrsOf !OptionType
  | OptionTypeOneOf ![OptionType]
  | OptionTypeSubmodule !(Map Text Option)
  deriving (Int -> OptionType -> ShowS
[OptionType] -> ShowS
OptionType -> String
(Int -> OptionType -> ShowS)
-> (OptionType -> String)
-> ([OptionType] -> ShowS)
-> Show OptionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OptionType -> ShowS
showsPrec :: Int -> OptionType -> ShowS
$cshow :: OptionType -> String
show :: OptionType -> String
$cshowList :: [OptionType] -> ShowS
showList :: [OptionType] -> ShowS
Show, OptionType -> OptionType -> Bool
(OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> Bool) -> Eq OptionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptionType -> OptionType -> Bool
== :: OptionType -> OptionType -> Bool
$c/= :: OptionType -> OptionType -> Bool
/= :: OptionType -> OptionType -> Bool
Eq, Eq OptionType
Eq OptionType =>
(OptionType -> OptionType -> Ordering)
-> (OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> Bool)
-> (OptionType -> OptionType -> OptionType)
-> (OptionType -> OptionType -> OptionType)
-> Ord OptionType
OptionType -> OptionType -> Bool
OptionType -> OptionType -> Ordering
OptionType -> OptionType -> OptionType
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 :: OptionType -> OptionType -> Ordering
compare :: OptionType -> OptionType -> Ordering
$c< :: OptionType -> OptionType -> Bool
< :: OptionType -> OptionType -> Bool
$c<= :: OptionType -> OptionType -> Bool
<= :: OptionType -> OptionType -> Bool
$c> :: OptionType -> OptionType -> Bool
> :: OptionType -> OptionType -> Bool
$c>= :: OptionType -> OptionType -> Bool
>= :: OptionType -> OptionType -> Bool
$cmax :: OptionType -> OptionType -> OptionType
max :: OptionType -> OptionType -> OptionType
$cmin :: OptionType -> OptionType -> OptionType
min :: OptionType -> OptionType -> OptionType
Ord)

simplifyOptionType :: OptionType -> OptionType
simplifyOptionType :: OptionType -> OptionType
simplifyOptionType = OptionType -> OptionType
go
  where
    go :: OptionType -> OptionType
go = \case
      OptionType
OptionTypeNull -> OptionType
OptionTypeNull
      OptionTypeSimple Text
t -> Text -> OptionType
OptionTypeSimple Text
t
      OptionTypeEnum [Expr]
es -> [Expr] -> OptionType
OptionTypeEnum [Expr]
es
      OptionTypeNullOr OptionType
t -> case OptionType
t of
        OptionType
OptionTypeNull -> OptionType
OptionTypeNull
        OptionTypeNullOr OptionType
t' -> OptionType -> OptionType
go (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
OptionTypeNullOr OptionType
t'
        OptionTypeOneOf [OptionType]
os -> OptionType -> OptionType
OptionTypeNullOr (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
go (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ [OptionType] -> OptionType
OptionTypeOneOf ([OptionType] -> OptionType) -> [OptionType] -> OptionType
forall a b. (a -> b) -> a -> b
$ (OptionType -> Bool) -> [OptionType] -> [OptionType]
forall a. (a -> Bool) -> [a] -> [a]
filter (OptionType -> OptionType -> Bool
forall a. Eq a => a -> a -> Bool
/= OptionType
OptionTypeNull) ([OptionType] -> [OptionType]) -> [OptionType] -> [OptionType]
forall a b. (a -> b) -> a -> b
$ (OptionType -> OptionType) -> [OptionType] -> [OptionType]
forall a b. (a -> b) -> [a] -> [b]
map OptionType -> OptionType
go [OptionType]
os
        OptionType
_ -> OptionType -> OptionType
OptionTypeNullOr (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
go OptionType
t
      OptionTypeListOf OptionType
o -> OptionType -> OptionType
OptionTypeListOf (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
go OptionType
o
      OptionTypeAttrsOf OptionType
o -> OptionType -> OptionType
OptionTypeAttrsOf (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
go OptionType
o
      OptionTypeOneOf [OptionType]
os -> case [OptionType] -> [OptionType]
goEnums ([OptionType] -> [OptionType]) -> [OptionType] -> [OptionType]
forall a b. (a -> b) -> a -> b
$ [OptionType] -> [OptionType]
forall a. Ord a => [a] -> [a]
nubOrd ([OptionType] -> [OptionType]) -> [OptionType] -> [OptionType]
forall a b. (a -> b) -> a -> b
$ (OptionType -> [OptionType]) -> [OptionType] -> [OptionType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptionType -> [OptionType]
goOr [OptionType]
os of
        [OptionType
ot] -> OptionType
ot
        [OptionType]
os' ->
          if OptionType
OptionTypeNull OptionType -> [OptionType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [OptionType]
os'
            then OptionType -> OptionType
go (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ OptionType -> OptionType
OptionTypeNullOr (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ case (OptionType -> Bool) -> [OptionType] -> [OptionType]
forall a. (a -> Bool) -> [a] -> [a]
filter (OptionType -> OptionType -> Bool
forall a. Eq a => a -> a -> Bool
/= OptionType
OptionTypeNull) [OptionType]
os' of
              [OptionType
t] -> OptionType
t
              [OptionType]
ts' -> [OptionType] -> OptionType
OptionTypeOneOf [OptionType]
ts'
            else [OptionType] -> OptionType
OptionTypeOneOf [OptionType]
os'
      OptionTypeSubmodule Map Text Option
m -> Map Text Option -> OptionType
OptionTypeSubmodule (Map Text Option -> OptionType) -> Map Text Option -> OptionType
forall a b. (a -> b) -> a -> b
$ (Option -> Option) -> Map Text Option -> Map Text Option
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Option -> Option
goOpt Map Text Option
m

    goEnums :: [OptionType] -> [OptionType]
    goEnums :: [OptionType] -> [OptionType]
goEnums = [Expr] -> [OptionType] -> [OptionType]
goEnum []
      where
        goEnum :: [Expr] -> [OptionType] -> [OptionType]
        goEnum :: [Expr] -> [OptionType] -> [OptionType]
goEnum [Expr]
es = \case
          [] -> case [Expr]
es of
            [] -> []
            [Expr]
_ -> [[Expr] -> OptionType
OptionTypeEnum [Expr]
es]
          (OptionType
t : [OptionType]
rest) -> case OptionType
t of
            OptionTypeEnum [Expr]
es' -> [Expr] -> [OptionType] -> [OptionType]
goEnum ([Expr]
es [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
es') [OptionType]
rest
            OptionType
_ -> OptionType
t OptionType -> [OptionType] -> [OptionType]
forall a. a -> [a] -> [a]
: [Expr] -> [OptionType] -> [OptionType]
goEnum [Expr]
es [OptionType]
rest

    goOpt :: Option -> Option
goOpt Option
o = Option
o {optionType = go <$> optionType o}

    goOr :: OptionType -> [OptionType]
goOr = \case
      OptionTypeOneOf [OptionType]
os -> (OptionType -> [OptionType]) -> [OptionType] -> [OptionType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptionType -> [OptionType]
goOr [OptionType]
os
      OptionType
o -> [OptionType
o]

simplifyOptions :: Map Text Option -> Map Text Option
simplifyOptions :: Map Text Option -> Map Text Option
simplifyOptions = (Option -> Option) -> Map Text Option -> Map Text Option
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Option -> Option
simplifyOption

renderOption :: Option -> Text
renderOption :: Option -> Text
renderOption = Expr -> Text
renderExpr (Expr -> Text) -> (Option -> Expr) -> Option -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
withNixArgs (Expr -> Expr) -> (Option -> Expr) -> Option -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Expr
optionExpr

renderOptions :: Map Text Option -> Text
renderOptions :: Map Text Option -> Text
renderOptions = Expr -> Text
renderExpr (Expr -> Text)
-> (Map Text Option -> Expr) -> Map Text Option -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
withNixArgs (Expr -> Expr)
-> (Map Text Option -> Expr) -> Map Text Option -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Option -> Expr
optionsExpr

renderOptionType :: OptionType -> Text
renderOptionType :: OptionType -> Text
renderOptionType = Expr -> Text
renderExpr (Expr -> Text) -> (OptionType -> Expr) -> OptionType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
withNixArgs (Expr -> Expr) -> (OptionType -> Expr) -> OptionType -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionType -> Expr
optionTypeExpr

withNixArgs :: Expr -> Expr
withNixArgs :: Expr -> Expr
withNixArgs = [Text] -> Expr -> Expr
ExprFun [Text
"lib"]

optionExpr :: Option -> Expr
optionExpr :: Option -> Expr
optionExpr Option {Maybe Value
Maybe Text
Maybe OptionType
optionType :: Option -> Maybe OptionType
optionDescription :: Option -> Maybe Text
optionDefault :: Option -> Maybe Value
optionType :: Maybe OptionType
optionDescription :: Maybe Text
optionDefault :: Maybe Value
..} =
  Expr -> Expr -> Expr
ExprAp
    (Text -> Expr
ExprVar Text
"lib.mkOption")
    ( Map Text Expr -> Expr
ExprAttrSet (Map Text Expr -> Expr) -> Map Text Expr -> Expr
forall a b. (a -> b) -> a -> b
$
        [(Text, Expr)] -> Map Text Expr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Expr)] -> Map Text Expr)
-> [(Text, Expr)] -> Map Text Expr
forall a b. (a -> b) -> a -> b
$
          [[(Text, Expr)]] -> [(Text, Expr)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [(Text
"type", OptionType -> Expr
optionTypeExpr OptionType
typ) | OptionType
typ <- Maybe OptionType -> [OptionType]
forall a. Maybe a -> [a]
maybeToList Maybe OptionType
optionType],
              [(Text
"description", Text -> Expr
ExprLitString Text
d) | Text
d <- Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
optionDescription],
              case Maybe Value
optionDefault of
                Maybe Value
Nothing -> case Maybe OptionType
optionType of
                  -- Automatically give submodule options a default of the empty set.
                  Just (OptionTypeSubmodule Map Text Option
_) -> [(Text
"default", Map Text Expr -> Expr
ExprAttrSet Map Text Expr
forall k a. Map k a
M.empty)]
                  Maybe OptionType
_ -> []
                Just Value
d -> [(Text
"default", Value -> Expr
jsonValueExpr Value
d)]
            ]
    )

optionsExpr :: Map Text Option -> Expr
optionsExpr :: Map Text Option -> Expr
optionsExpr = Map Text Expr -> Expr
ExprAttrSet (Map Text Expr -> Expr)
-> (Map Text Option -> Map Text Expr) -> Map Text Option -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Option -> Expr) -> Map Text Option -> Map Text Expr
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Option -> Expr
optionExpr

optionTypeExpr :: OptionType -> Expr
optionTypeExpr :: OptionType -> Expr
optionTypeExpr = OptionType -> Expr
go
  where
    go :: OptionType -> Expr
go = \case
      OptionType
OptionTypeNull -> Expr -> Expr -> Expr
ExprAp (Text -> Expr
ExprVar Text
"lib.types.enum") ([Expr] -> Expr
ExprLitList [Expr
ExprNull])
      OptionTypeSimple Text
s -> Text -> Expr
ExprVar Text
s
      OptionTypeEnum [Expr]
es -> Expr -> Expr -> Expr
ExprAp (Text -> Expr
ExprVar Text
"lib.types.enum") ([Expr] -> Expr
ExprLitList [Expr]
es)
      OptionTypeNullOr OptionType
ot -> Expr -> Expr -> Expr
ExprAp (Text -> Expr
ExprVar Text
"lib.types.nullOr") (OptionType -> Expr
go OptionType
ot)
      OptionTypeListOf OptionType
ot ->
        Expr -> Expr -> Expr
ExprAp
          (Text -> Expr
ExprVar Text
"lib.types.listOf")
          (OptionType -> Expr
go OptionType
ot)
      OptionTypeAttrsOf OptionType
ot ->
        Expr -> Expr -> Expr
ExprAp
          (Text -> Expr
ExprVar Text
"lib.types.attrsOf")
          (OptionType -> Expr
go OptionType
ot)
      OptionTypeOneOf [OptionType]
os ->
        Expr -> Expr -> Expr
ExprAp
          (Text -> Expr
ExprVar Text
"lib.types.oneOf")
          ([Expr] -> Expr
ExprLitList ((OptionType -> Expr) -> [OptionType] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map OptionType -> Expr
go [OptionType]
os))
      OptionTypeSubmodule Map Text Option
os ->
        Expr -> Expr -> Expr
ExprAp
          (Text -> Expr
ExprVar Text
"lib.types.submodule")
          (Map Text Expr -> Expr
ExprAttrSet (Text -> Expr -> Map Text Expr
forall k a. k -> a -> Map k a
M.singleton Text
"options" (Map Text Option -> Expr
optionsExpr Map Text Option
os)))

jsonValueExpr :: JSON.Value -> Expr
jsonValueExpr :: Value -> Expr
jsonValueExpr = \case
  Value
JSON.Null -> Expr
ExprNull
  JSON.Bool Bool
b -> Bool -> Expr
ExprLitBool Bool
b
  JSON.String Text
s -> Text -> Expr
ExprLitString Text
s
  JSON.Number Scientific
n -> Scientific -> Expr
ExprLitNumber Scientific
n
  JSON.Array Array
v -> [Expr] -> Expr
ExprLitList ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (Value -> Expr) -> [Value] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Expr
jsonValueExpr ([Value] -> [Expr]) -> [Value] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v
  JSON.Object Object
vs -> Map Text Expr -> Expr
ExprAttrSet (Map Text Expr -> Expr) -> Map Text Expr -> Expr
forall a b. (a -> b) -> a -> b
$ (Key -> Text) -> Map Key Expr -> Map Text Expr
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic Key -> Text
Key.toText (Map Key Expr -> Map Text Expr) -> Map Key Expr -> Map Text Expr
forall a b. (a -> b) -> a -> b
$ KeyMap Expr -> Map Key Expr
forall v. KeyMap v -> Map Key v
KeyMap.toMap (KeyMap Expr -> Map Key Expr) -> KeyMap Expr -> Map Key Expr
forall a b. (a -> b) -> a -> b
$ (Value -> Expr) -> Object -> KeyMap Expr
forall a b. (a -> b) -> KeyMap a -> KeyMap b
KeyMap.map Value -> Expr
jsonValueExpr Object
vs

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

renderExpr :: Expr -> Text
renderExpr :: Expr -> Text
renderExpr = [Text] -> Text
T.unlines ([Text] -> Text) -> (Expr -> [Text]) -> Expr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> [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 -> Expr -> [Text]
go Int
d = \case
      Expr
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 [Expr]
es -> case [Expr]
es of
        [] -> [Text
"[]"]
        [Expr
e] -> Text -> Text -> [Text] -> [Text]
surround Text
"[" Text
"]" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Expr -> [Text]
go Int
0 Expr
e
        [Expr]
_ ->
          -- 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 ((Expr -> [Text]) -> [Expr] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Expr -> [Text]
go Int
11) [Expr]
es) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"]"]
      ExprVar Text
s -> [Text
s]
      ExprAttrSet Map Text Expr
m | Map Text Expr -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Expr
m -> [Text
"{ }"]
      ExprAttrSet Map Text Expr
m ->
        -- We always put "{" and "}" on separate lines.
        Text
"{" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
indent (((Text, Expr) -> [Text]) -> [(Text, Expr)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> Expr -> [Text]) -> (Text, Expr) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expr -> [Text]
goBind) (Map Text Expr -> [(Text, Expr)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Expr
m)) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"}"]
      ExprAp Expr
e1 Expr
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 -> Expr -> [Text]
go Int
11 Expr
e1 [Text] -> [Text] -> [Text]
`apply` Int -> Expr -> [Text]
go Int
11 Expr
e2
      ExprFun [Text]
args Expr
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 -> Expr -> [Text]
go Int
0 Expr
e
      ExprWith Text
t Expr
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 -> Expr -> [Text]
go Int
0 Expr
e
    goBind :: Text -> Expr -> [Text]
goBind Text
key Expr
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 -> Expr -> [Text]
go Int
0 Expr
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
<>)

prepend :: Text -> [Text] -> [Text]
prepend :: Text -> [Text] -> [Text]
prepend = Text -> Text -> [Text] -> [Text]
prependWith Text
T.empty

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)