{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}

module Ide.Plugin.Properties
  ( PropertyType (..),
    ToHsType,
    NotElem,
    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           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

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) =>
    { 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

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

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

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 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, FindByKeyName s r ~ t, KnownSymbol s, FindPropertyMeta s r t)
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 (a :: PropertyKey) (s :: Symbol) (t :: PropertyType)
       (ks :: [PropertyKey]).
(a ~ 'PropertyKey s t, KnownSymbol s, NotElem s ks) =>
KeyNameProxy s
-> SPropertyKey a
-> MetaData t
-> Properties ks
-> Properties (a : 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
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 (a :: Symbol). SPropertyKey ('PropertyKey a '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 (a :: Symbol). SPropertyKey ('PropertyKey a '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 (a :: Symbol). SPropertyKey ('PropertyKey a '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 (a :: Symbol). SPropertyKey ('PropertyKey a '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 a (s :: Symbol).
(ToJSON a, FromJSON a) =>
Proxy a -> SPropertyKey ('PropertyKey s ('TObject a))
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 a (s :: Symbol).
(ToJSON a, FromJSON a) =>
Proxy a -> SPropertyKey ('PropertyKey s ('TArray a))
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 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 :: 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

-- | 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
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 ->
       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
<> KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= SomePropertyKeyWithMetaData -> 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) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: Text -> Properties ks -> [Pair]
forall (r :: [PropertyKey]). Text -> Properties r -> [Pair]
toVSCodeExtensionSchema Text
prefix Properties ks
xs
  where
    toEntry :: SomePropertyKeyWithMetaData -> A.Value
    toEntry :: SomePropertyKeyWithMetaData -> 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
..}) ->
        [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
..}) ->
        [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
..}) ->
        [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
..}) ->
        [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
..}) ->
        [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
..}) ->
        [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]
..}) ->
        [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"
          ]