{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}


module Ide.Plugin.Properties
  ( PropertyType (..),
    ToHsType,
    NotElem,
    MetaData (..),
    PropertyKey (..),
    SPropertyKey (..),
    KeyNameProxy (..),
    KeyNamePath (..),
    Properties,
    HasProperty,
    HasPropertyByPath,
    emptyProperties,
    defineNumberProperty,
    defineIntegerProperty,
    defineStringProperty,
    defineBooleanProperty,
    defineObjectProperty,
    defineArrayProperty,
    defineEnumProperty,
    definePropertiesProperty,
    toDefaultJSON,
    toVSCodeExtensionSchema,
    usePropertyEither,
    useProperty,
    usePropertyByPathEither,
    usePropertyByPath,
    (&),
  )
where

import           Control.Arrow        (first)
import qualified Data.Aeson           as A
import qualified Data.Aeson.Types     as A
import           Data.Either          (fromRight)
import           Data.Function        ((&))
import           Data.Kind            (Constraint, Type)
import           Data.Proxy           (Proxy (..))
import           Data.String          (IsString (fromString))
import qualified Data.Text            as T
import           GHC.OverloadedLabels (IsLabel (..))
import           GHC.TypeLits


-- | Types properties may have
data PropertyType
  = TNumber
  | TInteger
  | TString
  | TBoolean
  | TObject Type
  | TArray Type
  | TEnum Type
  | TProperties [PropertyKey] -- ^ A typed TObject, defined in a recursive manner

type family ToHsType (t :: PropertyType) where
  ToHsType 'TNumber = Double -- in js, there are no distinct types for integers and floating-point values
  ToHsType 'TInteger = Int   -- so here we use Double for Number, Int for Integer
  ToHsType 'TString = T.Text
  ToHsType 'TBoolean = Bool
  ToHsType ('TObject a) = a
  ToHsType ('TArray a) = [a]
  ToHsType ('TEnum a) = a
  ToHsType ('TProperties _) = A.Object

-- ---------------------------------------------------------------------

-- | Metadata of a property
data MetaData (t :: PropertyType) where
  MetaData ::
    (IsTEnum t ~ 'False, IsProperties t ~ 'False) =>
    { forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t,
      forall (t :: PropertyType). MetaData t -> Text
description :: T.Text
    } ->
    MetaData t
  EnumMetaData ::
    (IsTEnum t ~ 'True) =>
    { defaultValue :: ToHsType t,
      description :: T.Text,
      forall (t :: PropertyType). MetaData t -> [ToHsType t]
enumValues :: [ToHsType t],
      forall (t :: PropertyType). MetaData t -> [Text]
enumDescriptions :: [T.Text]
    } ->
    MetaData t
  PropertiesMetaData ::
    (t ~ TProperties rs) =>
    {
      defaultValue :: ToHsType t
      , description :: T.Text
      , ()
childrenProperties :: Properties rs
    } ->
    MetaData t


-- | Used at type level for name-type mapping in 'Properties'
data PropertyKey = PropertyKey Symbol PropertyType

-- | Singleton type of 'PropertyKey'
data SPropertyKey (k :: PropertyKey) where
  SNumber :: SPropertyKey ('PropertyKey s 'TNumber)
  SInteger :: SPropertyKey ('PropertyKey s 'TInteger)
  SString :: SPropertyKey ('PropertyKey s 'TString)
  SBoolean :: SPropertyKey ('PropertyKey s 'TBoolean)
  SObject :: (A.ToJSON a, A.FromJSON a) => Proxy a -> SPropertyKey ('PropertyKey s ('TObject a))
  SArray :: (A.ToJSON a, A.FromJSON a) => Proxy a -> SPropertyKey ('PropertyKey s ('TArray a))
  SEnum :: (A.ToJSON a, A.FromJSON a, Eq a, Show a) => Proxy a -> SPropertyKey ('PropertyKey s ('TEnum a))
  SProperties :: SPropertyKey ('PropertyKey s ('TProperties pp))

-- | Existential wrapper of 'SPropertyKey', with an extra 'MetaData'
data SomePropertyKeyWithMetaData
  = forall k s t.
    (k ~ 'PropertyKey s t) =>
    SomePropertyKeyWithMetaData (SPropertyKey k) (MetaData t)

-- | 'Properties' is a partial implementation of json schema, without supporting union types and validation.
-- In hls, it defines a set of properties used in dedicated configuration of a plugin.
-- A property is an immediate child of the json object in each plugin's "config" section.
-- It was designed to be compatible with vscode's settings UI.
-- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'.
data Properties (r :: [PropertyKey]) where
    ConsProperties :: (k ~ 'PropertyKey s t, KnownSymbol s, NotElem s ks)
        => KeyNameProxy s -> (SPropertyKey k) -> (MetaData t) -> Properties ks -> Properties (k : ks)
    EmptyProperties :: Properties '[]

-- | A proxy type in order to allow overloaded labels as properties' names at the call site
data KeyNameProxy (s :: Symbol) = KnownSymbol s => KeyNameProxy

instance (KnownSymbol s', s ~ s') => IsLabel s (KeyNameProxy s') where
  fromLabel :: KeyNameProxy s'
fromLabel = KeyNameProxy s'
forall (s :: Symbol). KnownSymbol s => KeyNameProxy s
KeyNameProxy

data NonEmptyList a =
    a :| NonEmptyList a | NE a

-- | a path to a property in a json object
data KeyNamePath (r :: NonEmptyList Symbol) where
   SingleKey :: KeyNameProxy s -> KeyNamePath (NE s)
   ConsKeysPath :: KeyNameProxy s1 -> KeyNamePath ss -> KeyNamePath (s1 :| ss)

class ParsePropertyPath (rs :: [PropertyKey]) (r :: NonEmptyList Symbol) where
    usePropertyByPathEither :: KeyNamePath r -> Properties rs -> A.Object -> Either String (ToHsType (FindByKeyPath r rs))
    useDefault :: KeyNamePath r -> Properties rs -> ToHsType (FindByKeyPath r rs)
    usePropertyByPath :: KeyNamePath r -> Properties rs -> A.Object -> ToHsType (FindByKeyPath r rs)
    usePropertyByPath KeyNamePath r
p Properties rs
ps Object
x = ToHsType (FindByKeyPath r rs)
-> Either String (ToHsType (FindByKeyPath r rs))
-> ToHsType (FindByKeyPath r rs)
forall b a. b -> Either a b -> b
fromRight (KeyNamePath r -> Properties rs -> ToHsType (FindByKeyPath r rs)
forall (rs :: [PropertyKey]) (r :: NonEmptyList Symbol).
ParsePropertyPath rs r =>
KeyNamePath r -> Properties rs -> ToHsType (FindByKeyPath r rs)
useDefault KeyNamePath r
p Properties rs
ps) (Either String (ToHsType (FindByKeyPath r rs))
 -> ToHsType (FindByKeyPath r rs))
-> Either String (ToHsType (FindByKeyPath r rs))
-> ToHsType (FindByKeyPath r rs)
forall a b. (a -> b) -> a -> b
$ KeyNamePath r
-> Properties rs
-> Object
-> Either String (ToHsType (FindByKeyPath r rs))
forall (rs :: [PropertyKey]) (r :: NonEmptyList Symbol).
ParsePropertyPath rs r =>
KeyNamePath r
-> Properties rs
-> Object
-> Either String (ToHsType (FindByKeyPath r rs))
usePropertyByPathEither KeyNamePath r
p Properties rs
ps Object
x

instance (HasProperty s k t r) => ParsePropertyPath r (NE s) where
    usePropertyByPathEither :: KeyNamePath ('NE s)
-> Properties r
-> Object
-> Either String (ToHsType (FindByKeyPath ('NE s) r))
usePropertyByPathEither (SingleKey KeyNameProxy s
kn) Properties r
sm Object
x = KeyNameProxy s
-> (SPropertyKey ('PropertyKey s t), MetaData t)
-> Object
-> Either String (ToHsType t)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t, KnownSymbol s) =>
KeyNameProxy s
-> (SPropertyKey k, MetaData t)
-> Object
-> Either String (ToHsType t)
parseProperty KeyNameProxy s
kn (KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s
kn Properties r
sm) Object
x
    useDefault :: KeyNamePath ('NE s)
-> Properties r -> ToHsType (FindByKeyPath ('NE s) r)
useDefault (SingleKey KeyNameProxy s
kn) Properties r
sm = MetaData t -> ToHsType t
forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue MetaData t
metadata
        where (SPropertyKey ('PropertyKey s t)
_, MetaData t
metadata) = KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s
kn Properties r
sm

instance ( ToHsType (FindByKeyPath ss r2) ~ ToHsType (FindByKeyPath (s :| ss) r)
          ,HasProperty s ('PropertyKey s ('TProperties r2)) t2 r
          , ParsePropertyPath r2 ss)
          => ParsePropertyPath r (s :| ss) where
    usePropertyByPathEither :: KeyNamePath (s ':| ss)
-> Properties r
-> Object
-> Either String (ToHsType (FindByKeyPath (s ':| ss) r))
usePropertyByPathEither (ConsKeysPath KeyNameProxy s1
kn KeyNamePath ss
p) Properties r
sm Object
x = do
        let (SPropertyKey ('PropertyKey s ('TProperties r2))
key, MetaData ('TProperties r2)
meta) = KeyNameProxy s1
-> Properties r
-> (SPropertyKey ('PropertyKey s ('TProperties r2)),
    MetaData ('TProperties r2))
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s1
kn Properties r
sm
        ToHsType ('TProperties r2)
interMedia <- KeyNameProxy s1
-> (SPropertyKey ('PropertyKey s ('TProperties r2)),
    MetaData ('TProperties r2))
-> Object
-> Either String (ToHsType ('TProperties r2))
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t, KnownSymbol s) =>
KeyNameProxy s
-> (SPropertyKey k, MetaData t)
-> Object
-> Either String (ToHsType t)
parseProperty KeyNameProxy s1
kn (SPropertyKey ('PropertyKey s ('TProperties r2))
key, MetaData ('TProperties r2)
meta) Object
x
        case MetaData ('TProperties r2)
meta of
            PropertiesMetaData {Text
Properties rs
ToHsType ('TProperties r2)
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
childrenProperties :: ()
defaultValue :: ToHsType ('TProperties r2)
description :: Text
childrenProperties :: Properties rs
..}
                -> KeyNamePath ss
-> Properties rs
-> Object
-> Either String (ToHsType (FindByKeyPath ss rs))
forall (rs :: [PropertyKey]) (r :: NonEmptyList Symbol).
ParsePropertyPath rs r =>
KeyNamePath r
-> Properties rs
-> Object
-> Either String (ToHsType (FindByKeyPath r rs))
usePropertyByPathEither KeyNamePath ss
p Properties rs
childrenProperties Object
ToHsType ('TProperties r2)
interMedia
    useDefault :: KeyNamePath (s ':| ss)
-> Properties r -> ToHsType (FindByKeyPath (s ':| ss) r)
useDefault (ConsKeysPath KeyNameProxy s1
kn KeyNamePath ss
p) Properties r
sm = case KeyNameProxy s1
-> Properties r
-> (SPropertyKey ('PropertyKey s ('TProperties r2)),
    MetaData ('TProperties r2))
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s1
kn Properties r
sm of
            (SPropertyKey ('PropertyKey s ('TProperties r2))
_, PropertiesMetaData {Text
Properties rs
ToHsType ('TProperties r2)
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
childrenProperties :: ()
defaultValue :: ToHsType ('TProperties r2)
description :: Text
childrenProperties :: Properties rs
..}) -> KeyNamePath ss -> Properties rs -> ToHsType (FindByKeyPath ss rs)
forall (rs :: [PropertyKey]) (r :: NonEmptyList Symbol).
ParsePropertyPath rs r =>
KeyNamePath r -> Properties rs -> ToHsType (FindByKeyPath r rs)
useDefault KeyNamePath ss
p Properties rs
childrenProperties

-- ---------------------------------------------------------------------

type family IsProperties (t :: PropertyType) :: Bool where
  IsProperties ('TProperties pp) = 'True
  IsProperties _ = 'False

type family IsTEnum (t :: PropertyType) :: Bool where
  IsTEnum ('TEnum _) = 'True
  IsTEnum _ = 'False

type family FindByKeyPath (ne :: NonEmptyList Symbol) (r :: [PropertyKey]) :: PropertyType where
  FindByKeyPath (s :| xs) ('PropertyKey s ('TProperties rs) ': _) = FindByKeyPath xs rs
  FindByKeyPath (s :| xs) (_ ': ys) = FindByKeyPath (s :| xs) ys
  FindByKeyPath (NE s) ys = FindByKeyName s ys

type family FindByKeyName (s :: Symbol) (r :: [PropertyKey]) :: PropertyType where
  FindByKeyName s ('PropertyKey s t ': _) = t
  FindByKeyName s (_ ': xs) = FindByKeyName s xs

type family IsPropertySymbol (s :: Symbol) (r :: PropertyKey) :: Bool where
    IsPropertySymbol s ('PropertyKey s _) = 'True
    IsPropertySymbol s _ = 'False

type family Elem (s :: Symbol) (r :: [PropertyKey]) :: Constraint where
  Elem s ('PropertyKey s _ ': _) = ()
  Elem s (_ ': xs) = Elem s xs
  Elem s '[] = TypeError ('Text "The key ‘" ':<>: 'Text s ':<>: 'Text "’ is missing")

type family NotElem (s :: Symbol) (r :: [PropertyKey]) :: Constraint where
  NotElem s ('PropertyKey s _ ': _) = TypeError ('Text "The key ‘" ':<>: 'Text s ':<>: 'Text "’ is already defined")
  NotElem s (_ ': xs) = NotElem s xs
  NotElem s '[] = ()


-- | In row @r@, there is a 'PropertyKey' @k@, which has name @s@ and carries haskell type @t@
type HasProperty s k t r = (k ~ 'PropertyKey s t, Elem s r, FindByKeyPath (NE s) r ~ t, FindByKeyName s r ~ t, KnownSymbol s, FindPropertyMeta s r t)
-- similar to HasProperty, but the path is given as a type-level list of symbols
type HasPropertyByPath props path t = (t ~ FindByKeyPath path props, ParsePropertyPath props path)
class FindPropertyMeta (s :: Symbol) (r :: [PropertyKey]) t where
   findSomePropertyKeyWithMetaData :: KeyNameProxy s -> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
instance (FindPropertyMetaIf (IsPropertySymbol symbol k) symbol k ks t) => FindPropertyMeta symbol (k : ks) t where
  findSomePropertyKeyWithMetaData :: KeyNameProxy symbol
-> Properties (k : ks)
-> (SPropertyKey ('PropertyKey symbol t), MetaData t)
findSomePropertyKeyWithMetaData = KeyNameProxy symbol
-> Properties (k : ks)
-> (SPropertyKey ('PropertyKey symbol t), MetaData t)
forall (bool :: Bool) (symbol :: Symbol) (k :: PropertyKey)
       (ks :: [PropertyKey]) (t :: PropertyType).
FindPropertyMetaIf bool symbol k ks t =>
KeyNameProxy symbol
-> Properties (k : ks)
-> (SPropertyKey ('PropertyKey symbol t), MetaData t)
findSomePropertyKeyWithMetaDataIf
class (bool ~ IsPropertySymbol symbol k) => FindPropertyMetaIf bool symbol k ks t where
  findSomePropertyKeyWithMetaDataIf :: KeyNameProxy symbol -> Properties (k : ks) -> (SPropertyKey ('PropertyKey symbol t), MetaData t)
instance (k ~ 'PropertyKey s t) => FindPropertyMetaIf 'True s k ks t where
  findSomePropertyKeyWithMetaDataIf :: KeyNameProxy s
-> Properties (k : ks)
-> (SPropertyKey ('PropertyKey s t), MetaData t)
findSomePropertyKeyWithMetaDataIf KeyNameProxy s
_ (ConsProperties KeyNameProxy s
_ SPropertyKey k
k MetaData t
m Properties ks
_) = (SPropertyKey k
SPropertyKey ('PropertyKey s t)
k, MetaData t
MetaData t
m)
instance ('False ~ IsPropertySymbol s k, FindPropertyMeta s ks t) => FindPropertyMetaIf 'False s k ks t where
  findSomePropertyKeyWithMetaDataIf :: KeyNameProxy s
-> Properties (k : ks)
-> (SPropertyKey ('PropertyKey s t), MetaData t)
findSomePropertyKeyWithMetaDataIf KeyNameProxy s
s (ConsProperties KeyNameProxy s
_ SPropertyKey k
_ MetaData t
_ Properties ks
ks) = KeyNameProxy s
-> Properties ks -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (r :: [PropertyKey]) (t :: PropertyType).
FindPropertyMeta s r t =>
KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
findSomePropertyKeyWithMetaData KeyNameProxy s
s Properties ks
ks

-- ---------------------------------------------------------------------

-- | Creates a 'Properties' that defines no property
--
-- Useful to start a definitions chain, for example:
-- @
-- properties =
--  emptyProperties
--    & defineStringProperty
--      #exampleString
--      "Description of exampleString"
--      "Foo"
--    & defineNumberProperty
--      #exampleNumber
--      "Description of exampleNumber"
--      233
-- @

emptyProperties :: Properties '[]
emptyProperties :: Properties '[]
emptyProperties = Properties '[]
EmptyProperties

insert ::
  (k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
  KeyNameProxy s ->
  SPropertyKey k ->
  MetaData t ->
  Properties r ->
  Properties (k ': r)
insert :: forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert = KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
forall (rs :: PropertyKey) (pp :: Symbol) (t :: PropertyType)
       (ks :: [PropertyKey]).
(rs ~ 'PropertyKey pp t, KnownSymbol pp, NotElem pp ks) =>
KeyNameProxy pp
-> SPropertyKey rs
-> MetaData t
-> Properties ks
-> Properties (rs : ks)
ConsProperties

find ::
  (HasProperty s k t r) =>
  KeyNameProxy s ->
  Properties r ->
  (SPropertyKey k, MetaData t)
find :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find = KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (r :: [PropertyKey]) (t :: PropertyType).
FindPropertyMeta s r t =>
KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
findSomePropertyKeyWithMetaData

-- ---------------------------------------------------------------------

-- | Given the name of a defined property, generates a JSON parser of 'plcConfig'
usePropertyEither ::
  (HasProperty s k t r) =>
  KeyNameProxy s ->
  Properties r ->
  A.Object ->
  Either String (ToHsType t)
usePropertyEither :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s
-> Properties r -> Object -> Either String (ToHsType t)
usePropertyEither KeyNameProxy s
kn Properties r
p = KeyNameProxy s
-> (SPropertyKey ('PropertyKey s t), MetaData t)
-> Object
-> Either String (ToHsType t)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t, KnownSymbol s) =>
KeyNameProxy s
-> (SPropertyKey k, MetaData t)
-> Object
-> Either String (ToHsType t)
parseProperty KeyNameProxy s
kn (KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s
kn Properties r
p)

-- | Like 'usePropertyEither' but returns 'defaultValue' on parse error
useProperty ::
  (HasProperty s k t r) =>
  KeyNameProxy s ->
  Properties r ->
  A.Object ->
  ToHsType t
useProperty :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> Object -> ToHsType t
useProperty KeyNameProxy s
kn Properties r
p = ToHsType t -> Either String (ToHsType t) -> ToHsType t
forall b a. b -> Either a b -> b
fromRight (MetaData t -> ToHsType t
forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue MetaData t
metadata) (Either String (ToHsType t) -> ToHsType t)
-> (Object -> Either String (ToHsType t)) -> Object -> ToHsType t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyNameProxy s
-> Properties r -> Object -> Either String (ToHsType t)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s
-> Properties r -> Object -> Either String (ToHsType t)
usePropertyEither KeyNameProxy s
kn Properties r
p
  where
    (SPropertyKey ('PropertyKey s t)
_, MetaData t
metadata) = KeyNameProxy s
-> Properties r -> (SPropertyKey ('PropertyKey s t), MetaData t)
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s
kn Properties r
p

parseProperty ::
  (k ~ 'PropertyKey s t, KnownSymbol s) =>
  KeyNameProxy s ->
  (SPropertyKey k, MetaData t) ->
  A.Object ->
  Either String (ToHsType t)
parseProperty :: forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t, KnownSymbol s) =>
KeyNameProxy s
-> (SPropertyKey k, MetaData t)
-> Object
-> Either String (ToHsType t)
parseProperty KeyNameProxy s
kn (SPropertyKey k, MetaData t)
k Object
x = case (SPropertyKey k, MetaData t)
k of
  (SPropertyKey k
SProperties, MetaData t
_) -> Either String Object
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SNumber, MetaData t
_) -> Either String Double
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SInteger, MetaData t
_) -> Either String Int
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SString, MetaData t
_) -> Either String Text
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SBoolean, MetaData t
_) -> Either String Bool
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SObject Proxy a
_, MetaData t
_) -> Either String a
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SArray Proxy a
_, MetaData t
_) -> Either String [a]
Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SEnum Proxy a
_, EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
defaultValue :: ToHsType t
description :: Text
enumValues :: [ToHsType t]
enumDescriptions :: [Text]
..}) ->
    (Object -> Parser a) -> Object -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
A.parseEither
      ( \Object
o -> do
          a
txt <- Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
key
          if a
txt a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
[ToHsType t]
enumValues
            then a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txt
            else
              String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$
                String
"invalid enum member: "
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
txt
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Expected one of "
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
show [a]
[ToHsType t]
enumValues
      )
      Object
x
  where
    key :: Key
key = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
kn
    parseEither :: forall a. A.FromJSON a => Either String a
    parseEither :: forall a. FromJSON a => Either String a
parseEither = (Object -> Parser a) -> Object -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
A.parseEither (Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
key) Object
x

-- ---------------------------------------------------------------------

-- | Defines a number property
defineNumberProperty ::
  (KnownSymbol s, NotElem s r) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  Double ->
  Properties r ->
  Properties ('PropertyKey s 'TNumber : r)
defineNumberProperty :: forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Double
-> Properties r
-> Properties ('PropertyKey s 'TNumber : r)
defineNumberProperty KeyNameProxy s
kn Text
description Double
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s 'TNumber)
-> MetaData 'TNumber
-> Properties r
-> Properties ('PropertyKey s 'TNumber : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn SPropertyKey ('PropertyKey s 'TNumber)
forall (rs :: Symbol). SPropertyKey ('PropertyKey rs 'TNumber)
SNumber MetaData {Double
Text
ToHsType 'TNumber
defaultValue :: ToHsType 'TNumber
description :: Text
description :: Text
defaultValue :: Double
..}

-- | Defines an integer property
defineIntegerProperty ::
  (KnownSymbol s, NotElem s r) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  Int ->
  Properties r ->
  Properties ('PropertyKey s 'TInteger : r)
defineIntegerProperty :: forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Int
-> Properties r
-> Properties ('PropertyKey s 'TInteger : r)
defineIntegerProperty KeyNameProxy s
kn Text
description Int
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s 'TInteger)
-> MetaData 'TInteger
-> Properties r
-> Properties ('PropertyKey s 'TInteger : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn SPropertyKey ('PropertyKey s 'TInteger)
forall (rs :: Symbol). SPropertyKey ('PropertyKey rs 'TInteger)
SInteger MetaData {Int
Text
ToHsType 'TInteger
defaultValue :: ToHsType 'TInteger
description :: Text
description :: Text
defaultValue :: Int
..}

-- | Defines a string property
defineStringProperty ::
  (KnownSymbol s, NotElem s r) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  T.Text ->
  Properties r ->
  Properties ('PropertyKey s 'TString : r)
defineStringProperty :: forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Text
-> Properties r
-> Properties ('PropertyKey s 'TString : r)
defineStringProperty KeyNameProxy s
kn Text
description Text
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s 'TString)
-> MetaData 'TString
-> Properties r
-> Properties ('PropertyKey s 'TString : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn SPropertyKey ('PropertyKey s 'TString)
forall (rs :: Symbol). SPropertyKey ('PropertyKey rs 'TString)
SString MetaData {Text
ToHsType 'TString
defaultValue :: ToHsType 'TString
description :: Text
description :: Text
defaultValue :: Text
..}

-- | Defines a boolean property
defineBooleanProperty ::
  (KnownSymbol s, NotElem s r) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  Bool ->
  Properties r ->
  Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty :: forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty KeyNameProxy s
kn Text
description Bool
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s 'TBoolean)
-> MetaData 'TBoolean
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn SPropertyKey ('PropertyKey s 'TBoolean)
forall (rs :: Symbol). SPropertyKey ('PropertyKey rs 'TBoolean)
SBoolean MetaData {Bool
Text
ToHsType 'TBoolean
defaultValue :: ToHsType 'TBoolean
description :: Text
description :: Text
defaultValue :: Bool
..}

-- | Defines an object property
defineObjectProperty ::
  (KnownSymbol s, NotElem s r, A.ToJSON a, A.FromJSON a) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  a ->
  Properties r ->
  Properties ('PropertyKey s ('TObject a) : r)
defineObjectProperty :: forall (s :: Symbol) (r :: [PropertyKey]) a.
(KnownSymbol s, NotElem s r, ToJSON a, FromJSON a) =>
KeyNameProxy s
-> Text
-> a
-> Properties r
-> Properties ('PropertyKey s ('TObject a) : r)
defineObjectProperty KeyNameProxy s
kn Text
description a
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s ('TObject a))
-> MetaData ('TObject a)
-> Properties r
-> Properties ('PropertyKey s ('TObject a) : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn (Proxy a -> SPropertyKey ('PropertyKey s ('TObject a))
forall rs (pp :: Symbol).
(ToJSON rs, FromJSON rs) =>
Proxy rs -> SPropertyKey ('PropertyKey pp ('TObject rs))
SObject Proxy a
forall {k} (t :: k). Proxy t
Proxy) MetaData {a
Text
ToHsType ('TObject a)
defaultValue :: ToHsType ('TObject a)
description :: Text
description :: Text
defaultValue :: a
..}

-- | Defines an array property
defineArrayProperty ::
  (KnownSymbol s, NotElem s r, A.ToJSON a, A.FromJSON a) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | default value
  [a] ->
  Properties r ->
  Properties ('PropertyKey s ('TArray a) : r)
defineArrayProperty :: forall (s :: Symbol) (r :: [PropertyKey]) a.
(KnownSymbol s, NotElem s r, ToJSON a, FromJSON a) =>
KeyNameProxy s
-> Text
-> [a]
-> Properties r
-> Properties ('PropertyKey s ('TArray a) : r)
defineArrayProperty KeyNameProxy s
kn Text
description [a]
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s ('TArray a))
-> MetaData ('TArray a)
-> Properties r
-> Properties ('PropertyKey s ('TArray a) : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn (Proxy a -> SPropertyKey ('PropertyKey s ('TArray a))
forall rs (pp :: Symbol).
(ToJSON rs, FromJSON rs) =>
Proxy rs -> SPropertyKey ('PropertyKey pp ('TArray rs))
SArray Proxy a
forall {k} (t :: k). Proxy t
Proxy) MetaData {[a]
Text
ToHsType ('TArray a)
defaultValue :: ToHsType ('TArray a)
description :: Text
description :: Text
defaultValue :: [a]
..}

-- | Defines an enum property
defineEnumProperty ::
  (KnownSymbol s, NotElem s r, A.ToJSON a, A.FromJSON a, Eq a, Show a) =>
  KeyNameProxy s ->
  -- | description
  T.Text ->
  -- | valid enum members with each of description
  [(a, T.Text)] ->
  a ->
  Properties r ->
  Properties ('PropertyKey s ('TEnum a) : r)
defineEnumProperty :: forall (s :: Symbol) (r :: [PropertyKey]) a.
(KnownSymbol s, NotElem s r, ToJSON a, FromJSON a, Eq a, Show a) =>
KeyNameProxy s
-> Text
-> [(a, Text)]
-> a
-> Properties r
-> Properties ('PropertyKey s ('TEnum a) : r)
defineEnumProperty KeyNameProxy s
kn Text
description [(a, Text)]
enums a
defaultValue =
  KeyNameProxy s
-> SPropertyKey ('PropertyKey s ('TEnum a))
-> MetaData ('TEnum a)
-> Properties r
-> Properties ('PropertyKey s ('TEnum a) : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn (Proxy a -> SPropertyKey ('PropertyKey s ('TEnum a))
forall rs (pp :: Symbol).
(ToJSON rs, FromJSON rs, Eq rs, Show rs) =>
Proxy rs -> SPropertyKey ('PropertyKey pp ('TEnum rs))
SEnum Proxy a
forall {k} (t :: k). Proxy t
Proxy) (MetaData ('TEnum a)
 -> Properties r -> Properties ('PropertyKey s ('TEnum a) : r))
-> MetaData ('TEnum a)
-> Properties r
-> Properties ('PropertyKey s ('TEnum a) : r)
forall a b. (a -> b) -> a -> b
$ ToHsType ('TEnum a)
-> Text -> [ToHsType ('TEnum a)] -> [Text] -> MetaData ('TEnum a)
forall (t :: PropertyType).
(IsTEnum t ~ 'True) =>
ToHsType t -> Text -> [ToHsType t] -> [Text] -> MetaData t
EnumMetaData a
ToHsType ('TEnum a)
defaultValue Text
description ((a, Text) -> a
forall a b. (a, b) -> a
fst ((a, Text) -> a) -> [(a, Text)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Text)]
enums) ((a, Text) -> Text
forall a b. (a, b) -> b
snd ((a, Text) -> Text) -> [(a, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Text)]
enums)

definePropertiesProperty ::
  (KnownSymbol s, NotElem s r) =>
  KeyNameProxy s ->
  T.Text ->
  Properties childrenProps ->
  Properties r ->
  Properties ('PropertyKey s ('TProperties childrenProps) : r)
definePropertiesProperty :: forall (s :: Symbol) (r :: [PropertyKey])
       (childrenProps :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Properties childrenProps
-> Properties r
-> Properties ('PropertyKey s ('TProperties childrenProps) : r)
definePropertiesProperty KeyNameProxy s
kn Text
description Properties childrenProps
ps Properties r
rs =
    KeyNameProxy s
-> SPropertyKey ('PropertyKey s ('TProperties childrenProps))
-> MetaData ('TProperties childrenProps)
-> Properties r
-> Properties ('PropertyKey s ('TProperties childrenProps) : r)
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (r :: [PropertyKey]).
(k ~ 'PropertyKey s t, NotElem s r, KnownSymbol s) =>
KeyNameProxy s
-> SPropertyKey k
-> MetaData t
-> Properties r
-> Properties (k : r)
insert KeyNameProxy s
kn SPropertyKey ('PropertyKey s ('TProperties childrenProps))
forall (rs :: Symbol) (pp :: [PropertyKey]).
SPropertyKey ('PropertyKey rs ('TProperties pp))
SProperties (ToHsType ('TProperties childrenProps)
-> Text
-> Properties childrenProps
-> MetaData ('TProperties childrenProps)
forall (t :: PropertyType) (rs :: [PropertyKey]).
(t ~ 'TProperties rs) =>
ToHsType t -> Text -> Properties rs -> MetaData t
PropertiesMetaData Object
ToHsType ('TProperties childrenProps)
forall a. Monoid a => a
mempty Text
description Properties childrenProps
ps) Properties r
rs

-- ---------------------------------------------------------------------

-- | Converts a properties definition into kv pairs with default values from 'MetaData'
toDefaultJSON :: Properties r -> [A.Pair]
toDefaultJSON :: forall (r :: [PropertyKey]). Properties r -> [Pair]
toDefaultJSON Properties r
pr = case Properties r
pr of
    Properties r
EmptyProperties -> []
    ConsProperties KeyNameProxy s
keyNameProxy SPropertyKey k
k MetaData t
m Properties ks
xs ->
        String -> SomePropertyKeyWithMetaData -> Pair
toEntry (KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy) (SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t) =>
SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
SomePropertyKeyWithMetaData SPropertyKey k
k MetaData t
m) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Properties ks -> [Pair]
forall (r :: [PropertyKey]). Properties r -> [Pair]
toDefaultJSON Properties ks
xs
  where
    toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair
    toEntry :: String -> SomePropertyKeyWithMetaData -> Pair
toEntry String
s = \case
      (SomePropertyKeyWithMetaData SPropertyKey k
SNumber MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Double
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SInteger MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SString MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SBoolean MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SObject Proxy a
_) MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SArray Proxy a
_) MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> [a] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [a]
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SEnum Proxy a
_) EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
defaultValue :: ToHsType t
description :: Text
enumValues :: [ToHsType t]
enumDescriptions :: [Text]
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SProperties  PropertiesMetaData {Text
Properties rs
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
childrenProperties :: ()
defaultValue :: ToHsType t
description :: Text
childrenProperties :: Properties rs
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Pair] -> Value
A.object (Properties rs -> [Pair]
forall (r :: [PropertyKey]). Properties r -> [Pair]
toDefaultJSON Properties rs
childrenProperties)

-- | Converts a properties definition into kv pairs as vscode schema
toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair]
toVSCodeExtensionSchema :: forall (r :: [PropertyKey]). Text -> Properties r -> [Pair]
toVSCodeExtensionSchema Text
prefix Properties r
p = [String -> Key
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. IsString a => String -> a
fromString String
k) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Value
v | (String
k, Value
v) <- Properties r -> [(String, Value)]
forall (r :: [PropertyKey]). Properties r -> [(String, Value)]
toVSCodeExtensionSchema' Properties r
p]
toVSCodeExtensionSchema' :: Properties r -> [(String, A.Value)]
toVSCodeExtensionSchema' :: forall (r :: [PropertyKey]). Properties r -> [(String, Value)]
toVSCodeExtensionSchema' Properties r
ps = case Properties r
ps of
    Properties r
EmptyProperties -> []
    ConsProperties (KeyNameProxy s
keyNameProxy :: KeyNameProxy s) (SPropertyKey k
k :: SPropertyKey k) (MetaData t
m :: MetaData t) Properties ks
xs ->
          [(KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) String
".") Maybe String
k1, Value
v)
            | (Maybe String
k1, Value
v) <- SomePropertyKeyWithMetaData -> [(Maybe String, Value)]
toEntry (SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t) =>
SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
SomePropertyKeyWithMetaData SPropertyKey k
k MetaData t
m) ]
          [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. [a] -> [a] -> [a]
++ Properties ks -> [(String, Value)]
forall (r :: [PropertyKey]). Properties r -> [(String, Value)]
toVSCodeExtensionSchema' Properties ks
xs
  where
    wrapEmpty :: A.Value -> [(Maybe String, A.Value)]
    wrapEmpty :: Value -> [(Maybe String, Value)]
wrapEmpty Value
v = [(Maybe String
forall a. Maybe a
Nothing, Value
v)]
    toEntry :: SomePropertyKeyWithMetaData -> [(Maybe String, A.Value)]
    toEntry :: SomePropertyKeyWithMetaData -> [(Maybe String, Value)]
toEntry = \case
      (SomePropertyKeyWithMetaData SPropertyKey k
SNumber MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"number",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Double
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SInteger MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"integer",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SString MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"string",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SBoolean MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"boolean",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SObject Proxy a
_) MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"object",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SArray Proxy a
_) MetaData {Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: ToHsType t
description :: Text
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"array",
            Key
"markdownDescription" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> [a] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [a]
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SEnum Proxy a
_) EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
defaultValue :: ToHsType t
description :: Text
enumValues :: [ToHsType t]
enumDescriptions :: [Text]
..}) ->
        Value -> [(Maybe String, Value)]
wrapEmpty (Value -> [(Maybe String, Value)])
-> Value -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"string",
            Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"enum" Key -> [a] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [a]
[ToHsType t]
enumValues,
            Key
"enumDescriptions" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Text]
enumDescriptions,
            Key
"default" Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SProperties PropertiesMetaData {Text
Properties rs
ToHsType t
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
childrenProperties :: ()
defaultValue :: ToHsType t
description :: Text
childrenProperties :: Properties rs
..}) ->
        ((String, Value) -> (Maybe String, Value))
-> [(String, Value)] -> [(Maybe String, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Maybe String)
-> (String, Value) -> (Maybe String, Value)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Maybe String
forall a. a -> Maybe a
Just) ([(String, Value)] -> [(Maybe String, Value)])
-> [(String, Value)] -> [(Maybe String, Value)]
forall a b. (a -> b) -> a -> b
$ Properties rs -> [(String, Value)]
forall (r :: [PropertyKey]). Properties r -> [(String, Value)]
toVSCodeExtensionSchema' Properties rs
childrenProperties