{-# 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
(
renderNixOptionTypeViaCodec,
renderNixOptionsViaCodec,
renderNixOptionTypeVia,
renderNixOptionsVia,
valueCodecNixOptionType,
objectCodecNixOptions,
Option (..),
OptionType (..),
renderOption,
renderOptionType,
optionExpr,
optionsExpr,
optionTypeExpr,
renderExpr,
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"
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"
OtherIntegerBounds Maybe IntegerSymbolic
_ Maybe IntegerSymbolic
_ -> Text
"lib.types.int"
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
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
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,
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
}
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
}
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)
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
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]
_ ->
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 ->
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)