{-# 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 = Set a
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 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> (EnumBaseType a -> a) -> EnumBaseType a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumBaseType a -> a
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 = AsLspEnum a

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

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