{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeFamilies #-}

module Language.LSP.Protocol.Types.LspEnum where

import Data.Aeson qualified as Aeson
import Data.Kind
import Data.Set qualified as Set
import Data.String (IsString (..))
import Data.Text qualified as Text

{- | A class for types that represent a LSP enum type.

 This class carries conversion functions to and from the 'base type' of the enum.
 Not all base type values may have corresponding enum values.
-}
class LspEnum a where
  -- | The base type of the enum.
  type EnumBaseType a :: Type

  -- | The known values of this type, the ones listed in the LSP specification.
  knownValues :: Set.Set a
  knownValues = forall a. Set a
Set.empty

  -- | Convert an enum value to the base type.
  toEnumBaseType :: a -> EnumBaseType a

  -- | Convert a base type value to an enum value, failing if it does not correspond to
  -- an enum value.
  fromEnumBaseType :: EnumBaseType a -> Maybe a
  default fromEnumBaseType :: (LspOpenEnum a) => EnumBaseType a -> Maybe a
  fromEnumBaseType = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LspOpenEnum a => EnumBaseType a -> a
fromOpenEnumBaseType

{- | A class for types that represent a LSP open enum type.

 Open enum types allow any base type value to be used as a 'custom' enum value.
-}
class LspEnum a => LspOpenEnum a where
  -- | Convert a base type to an enum value. All base type values can be converted this way.
  fromOpenEnumBaseType :: EnumBaseType a -> a

{- | Newtype for @deriving via@ to get standard JSON and 'IsString' instances in terms of the 'LspEnum'
 class methods.
-}
newtype AsLspEnum a b = AsLspEnum a

instance (LspEnum a, EnumBaseType a ~ b, Aeson.ToJSON b) => Aeson.ToJSON (AsLspEnum a b) where
  toJSON :: AsLspEnum a b -> Value
toJSON (AsLspEnum a
e) = forall a. ToJSON a => a -> Value
Aeson.toJSON (forall a. LspEnum a => a -> EnumBaseType a
toEnumBaseType a
e)

instance (LspEnum a, EnumBaseType a ~ b, Aeson.FromJSON b, Show b) => Aeson.FromJSON (AsLspEnum a b) where
  parseJSON :: Value -> Parser (AsLspEnum a b)
parseJSON Value
val = do
    b
v <- forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
val
    case forall a. LspEnum a => EnumBaseType a -> Maybe a
fromEnumBaseType b
v of
      Just a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> AsLspEnum a b
AsLspEnum a
x
      Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"unrecognized enum value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show b
v

instance (LspOpenEnum a, EnumBaseType a ~ b, b ~ Text.Text) => IsString (AsLspEnum a b) where
  fromString :: [Char] -> AsLspEnum a b
fromString [Char]
s = forall {k} a (b :: k). a -> AsLspEnum a b
AsLspEnum forall a b. (a -> b) -> a -> b
$ forall a. LspOpenEnum a => EnumBaseType a -> a
fromOpenEnumBaseType ([Char] -> Text
Text.pack [Char]
s)