{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
-- See Note [Constraints]
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

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

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 qualified Data.Map.Strict      as Map
import           Data.Proxy           (Proxy (..))
import           Data.String          (IsString (fromString))
import qualified Data.Text            as T
import           GHC.OverloadedLabels (IsLabel (..))
import           GHC.TypeLits
import           Unsafe.Coerce        (unsafeCoerce)

-- | Types properties may have
data PropertyType
  = TNumber
  | TInteger
  | TString
  | TBoolean
  | TObject Type
  | TArray Type
  | TEnum Type

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

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

-- | Metadata of a property
data MetaData (t :: PropertyType) where
  MetaData ::
    (IsTEnum t ~ 'False) =>
    { MetaData t -> ToHsType t
defaultValue :: ToHsType t,
      MetaData t -> Text
description :: T.Text
    } ->
    MetaData t
  EnumMetaData ::
    (IsTEnum t ~ 'True) =>
    { defaultValue :: ToHsType t,
      description :: T.Text,
      MetaData t -> [ToHsType t]
enumValues :: [ToHsType t],
      MetaData t -> [Text]
enumDescriptions :: [T.Text]
    } ->
    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))

-- | 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 which 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'.
newtype Properties (r :: [PropertyKey]) = Properties (Map.Map String SomePropertyKeyWithMetaData)

-- | 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

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

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

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

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, FindByKeyName s r ~ t, KnownSymbol s)

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

-- | 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 = Map String SomePropertyKeyWithMetaData -> Properties '[]
forall (r :: [PropertyKey]).
Map String SomePropertyKeyWithMetaData -> Properties r
Properties Map String SomePropertyKeyWithMetaData
forall k a. Map k a
Map.empty

insert ::
  (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)
insert KeyNameProxy s
kn SPropertyKey k
key MetaData t
metadata (Properties Map String SomePropertyKeyWithMetaData
old) =
  Map String SomePropertyKeyWithMetaData -> Properties (k : r)
forall (r :: [PropertyKey]).
Map String SomePropertyKeyWithMetaData -> Properties r
Properties
    ( String
-> SomePropertyKeyWithMetaData
-> Map String SomePropertyKeyWithMetaData
-> Map String SomePropertyKeyWithMetaData
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
        (KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
kn)
        (SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t) =>
SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
SomePropertyKeyWithMetaData SPropertyKey k
key MetaData t
metadata)
        Map String SomePropertyKeyWithMetaData
old
    )

find ::
  (HasProperty s k t r) =>
  KeyNameProxy s ->
  Properties r ->
  (SPropertyKey k, MetaData t)
find :: KeyNameProxy s -> Properties r -> (SPropertyKey k, MetaData t)
find KeyNameProxy s
kn (Properties Map String SomePropertyKeyWithMetaData
p) = case Map String SomePropertyKeyWithMetaData
p Map String SomePropertyKeyWithMetaData
-> String -> SomePropertyKeyWithMetaData
forall k a. Ord k => Map k a -> k -> a
Map.! KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
kn of
  (SomePropertyKeyWithMetaData SPropertyKey k
sing MetaData t
metadata) ->
    -- Note [Constraints]
    -- It's safe to use unsafeCoerce here:
    --   Since each property name is unique that the redefinition will be prevented by predication on the type level list,
    --   the value we get from the name-indexed map must be exactly the singleton and metadata corresponding to the type.
    -- We drop this information at type level: some of the above type families return '() :: Constraint',
    -- so GHC will consider them as redundant.
    -- But we encode it using semantically identical 'Map' at term level,
    -- which avoids inducting on the list by defining a new type class.
    (SPropertyKey k, MetaData t) -> (SPropertyKey k, MetaData t)
forall a b. a -> b
unsafeCoerce (SPropertyKey k
sing, MetaData t
metadata)

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

-- | 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 :: 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 :: 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 :: 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
SNumber, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SInteger, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SString, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SPropertyKey k
SBoolean, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SObject Proxy a
_, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SArray Proxy a
_, MetaData t
_) -> Either String (ToHsType t)
forall a. FromJSON a => Either String a
parseEither
  (SEnum Proxy a
_, EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
enumDescriptions :: [Text]
enumValues :: [ToHsType t]
description :: Text
defaultValue :: ToHsType t
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
    (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
[ToHsType t]
enumValues
            then a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
txt
            else
              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 :: 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 :: 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 (s :: Symbol). SPropertyKey ('PropertyKey s 'TNumber)
SNumber MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {Double
Text
ToHsType 'TNumber
defaultValue :: Double
description :: Text
description :: Text
defaultValue :: ToHsType 'TNumber
..}

-- | 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 :: 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 (s :: Symbol). SPropertyKey ('PropertyKey s 'TInteger)
SInteger MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {Int
Text
ToHsType 'TInteger
defaultValue :: Int
description :: Text
description :: Text
defaultValue :: ToHsType 'TInteger
..}

-- | 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 :: 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 (s :: Symbol). SPropertyKey ('PropertyKey s 'TString)
SString MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {Text
ToHsType 'TString
defaultValue :: Text
description :: Text
description :: Text
defaultValue :: ToHsType 'TString
..}

-- | 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 :: 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 (s :: Symbol). SPropertyKey ('PropertyKey s 'TBoolean)
SBoolean MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {Bool
Text
ToHsType 'TBoolean
defaultValue :: Bool
description :: Text
description :: Text
defaultValue :: ToHsType 'TBoolean
..}

-- | 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 :: 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 a (a :: Symbol).
(ToJSON a, FromJSON a) =>
Proxy a -> SPropertyKey ('PropertyKey a ('TObject a))
SObject Proxy a
forall k (t :: k). Proxy t
Proxy) MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {a
Text
ToHsType ('TObject a)
defaultValue :: a
description :: Text
description :: Text
defaultValue :: ToHsType ('TObject 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 :: 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 a (a :: Symbol).
(ToJSON a, FromJSON a) =>
Proxy a -> SPropertyKey ('PropertyKey a ('TArray a))
SArray Proxy a
forall k (t :: k). Proxy t
Proxy) MetaData :: forall (t :: PropertyType).
(IsTEnum t ~ 'False) =>
ToHsType t -> Text -> MetaData t
MetaData {[a]
Text
ToHsType ('TArray a)
defaultValue :: [a]
description :: Text
description :: Text
defaultValue :: ToHsType ('TArray 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 :: 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 a (s :: Symbol).
(ToJSON a, FromJSON a, Eq a, Show a) =>
Proxy a -> SPropertyKey ('PropertyKey s ('TEnum a))
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)

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

-- | Converts a properties definition into kv pairs with default values from 'MetaData'
toDefaultJSON :: Properties r -> [A.Pair]
toDefaultJSON :: Properties r -> [Pair]
toDefaultJSON (Properties Map String SomePropertyKeyWithMetaData
p) = [String -> SomePropertyKeyWithMetaData -> Pair
toEntry String
s SomePropertyKeyWithMetaData
v | (String
s, SomePropertyKeyWithMetaData
v) <- Map String SomePropertyKeyWithMetaData
-> [(String, SomePropertyKeyWithMetaData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String SomePropertyKeyWithMetaData
p]
  where
    toEntry :: String -> SomePropertyKeyWithMetaData -> A.Pair
    toEntry :: String -> SomePropertyKeyWithMetaData -> Pair
toEntry String
s = \case
      (SomePropertyKeyWithMetaData SPropertyKey k
SNumber MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Double
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SInteger MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SString MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData SPropertyKey k
SBoolean MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SObject Proxy a
_) MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SArray Proxy a
_) MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= [a]
ToHsType t
defaultValue
      (SomePropertyKeyWithMetaData (SEnum Proxy a
_) EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
enumDescriptions :: [Text]
enumValues :: [ToHsType t]
description :: Text
defaultValue :: ToHsType t
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue

-- | Converts a properties definition into kv pairs as vscode schema
toVSCodeExtensionSchema :: T.Text -> Properties r -> [A.Pair]
toVSCodeExtensionSchema :: Text -> Properties r -> [Pair]
toVSCodeExtensionSchema Text
prefix (Properties Map String SomePropertyKeyWithMetaData
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
k) Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= SomePropertyKeyWithMetaData -> Value
toEntry SomePropertyKeyWithMetaData
v | (String
k, SomePropertyKeyWithMetaData
v) <- Map String SomePropertyKeyWithMetaData
-> [(String, SomePropertyKeyWithMetaData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String SomePropertyKeyWithMetaData
p]
  where
    toEntry :: SomePropertyKeyWithMetaData -> A.Value
    toEntry :: SomePropertyKeyWithMetaData -> Value
toEntry = \case
      (SomePropertyKeyWithMetaData SPropertyKey k
SNumber MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"number",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Double
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SInteger MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"integer",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Int
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SString MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"string",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData SPropertyKey k
SBoolean MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"boolean",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Bool
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SObject Proxy a
_) MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"object",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SArray Proxy a
_) MetaData {Text
ToHsType t
description :: Text
defaultValue :: ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"array",
            Key
"markdownDescription" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"default" Key -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= [a]
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]
      (SomePropertyKeyWithMetaData (SEnum Proxy a
_) EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
enumDescriptions :: [Text]
enumValues :: [ToHsType t]
description :: Text
defaultValue :: ToHsType t
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) ->
        [Pair] -> Value
A.object
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"string",
            Key
"description" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
description,
            Key
"enum" Key -> [a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= [a]
[ToHsType t]
enumValues,
            Key
"enumDescriptions" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= [Text]
enumDescriptions,
            Key
"default" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= a
ToHsType t
defaultValue,
            Key
"scope" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource"
          ]