{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, ExistentialQuantification, FlexibleInstances, OverlappingInstances, CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- Note: the OverlappingInstances pragma is only here so the overlapping instances in this file
-- will work on older GHCs, like GHC 7.8.4

module Data.Aeson.TypeScript.Instances where

import qualified Data.Aeson as A
import Data.Aeson.TypeScript.Types
import Data.Data
import Data.HashMap.Strict
import qualified Data.List as L
import Data.Set
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Void

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

instance TypeScript () where
  getTypeScriptType :: Proxy () -> String
getTypeScriptType Proxy ()
_ = String
"void"

instance TypeScript Void where
  getTypeScriptType :: Proxy Void -> String
getTypeScriptType Proxy Void
_ = String
"void"

instance TypeScript T.Text where
  getTypeScriptType :: Proxy Text -> String
getTypeScriptType Proxy Text
_ = String
"string"

instance TypeScript TL.Text where
  getTypeScriptType :: Proxy Text -> String
getTypeScriptType Proxy Text
_ = String
"string"

instance TypeScript Integer where
  getTypeScriptType :: Proxy Integer -> String
getTypeScriptType Proxy Integer
_ = String
"number"

instance TypeScript Float where
  getTypeScriptType :: Proxy Float -> String
getTypeScriptType Proxy Float
_ = String
"number"

instance TypeScript Double where
  getTypeScriptType :: Proxy Double -> String
getTypeScriptType Proxy Double
_ = String
"number"

instance TypeScript Bool where
  getTypeScriptType :: Proxy Bool -> String
getTypeScriptType Proxy Bool
_ = String
"boolean"

instance TypeScript Int where
  getTypeScriptType :: Proxy Int -> String
getTypeScriptType Proxy Int
_ = String
"number"

instance TypeScript Char where
  getTypeScriptType :: Proxy Char -> String
getTypeScriptType Proxy Char
_ = String
"string"

instance {-# OVERLAPPABLE #-} (TypeScript a) => TypeScript [a] where
  getTypeScriptType :: Proxy [a] -> String
getTypeScriptType Proxy [a]
_ = (Proxy a -> String
forall k (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[]"
  getParentTypes :: Proxy [a] -> [TSType]
getParentTypes Proxy [a]
_ = (Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance {-# OVERLAPPING #-} TypeScript [Char] where
  getTypeScriptType :: Proxy String -> String
getTypeScriptType Proxy String
_ = String
"string"

instance (TypeScript a, TypeScript b) => TypeScript (Either a b) where
  getTypeScriptType :: Proxy (Either a b) -> String
getTypeScriptType Proxy (Either a b)
_ = [i|Either<#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}>|]
  getTypeScriptDeclarations :: Proxy (Either a b) -> [TSDeclaration]
getTypeScriptDeclarations Proxy (Either a b)
_ = [String -> [String] -> [String] -> TSDeclaration
TSTypeAlternatives String
"Either" [String
"T1", String
"T2"] [String
"Left<T1>", String
"Right<T2>"]
                               , String -> [String] -> [TSField] -> TSDeclaration
TSInterfaceDeclaration String
"Left" [String
"T"] [Bool -> String -> String -> TSField
TSField Bool
False String
"Left" String
"T"]
                               , String -> [String] -> [TSField] -> TSDeclaration
TSInterfaceDeclaration String
"Right" [String
"T"] [Bool -> String -> String -> TSField
TSField Bool
False String
"Right" String
"T"]
                               ]
  getParentTypes :: Proxy (Either a b) -> [TSType]
getParentTypes Proxy (Either a b)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub ((Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy b -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy b -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)))

instance (TypeScript a, TypeScript b) => TypeScript (a, b) where
  getTypeScriptType :: Proxy (a, b) -> String
getTypeScriptType Proxy (a, b)
_ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}]|]
  getParentTypes :: Proxy (a, b) -> [TSType]
getParentTypes Proxy (a, b)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub ((Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy b -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy b -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)))

instance (TypeScript a, TypeScript b, TypeScript c) => TypeScript (a, b, c) where
  getTypeScriptType :: Proxy (a, b, c) -> String
getTypeScriptType Proxy (a, b, c)
_ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}]|]
  getParentTypes :: Proxy (a, b, c) -> [TSType]
getParentTypes Proxy (a, b, c)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub ((Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy b -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy c -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy b -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy c -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c)))

instance (TypeScript a, TypeScript b, TypeScript c, TypeScript d) => TypeScript (a, b, c, d) where
  getTypeScriptType :: Proxy (a, b, c, d) -> String
getTypeScriptType Proxy (a, b, c, d)
_ = [i|[#{getTypeScriptType (Proxy :: Proxy a)}, #{getTypeScriptType (Proxy :: Proxy b)}, #{getTypeScriptType (Proxy :: Proxy c)}, #{getTypeScriptType (Proxy :: Proxy d)}]|]
  getParentTypes :: Proxy (a, b, c, d) -> [TSType]
getParentTypes Proxy (a, b, c, d)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub ((Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy b -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy c -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy d -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d))
                            TSType -> [TSType] -> [TSType]
forall a. a -> [a] -> [a]
: (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy b -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy c -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy d -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d)))

instance (TypeScript a) => TypeScript (Maybe a) where
  getTypeScriptType :: Proxy (Maybe a) -> String
getTypeScriptType Proxy (Maybe a)
_ = Proxy a -> String
forall k (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
  getTypeScriptOptional :: Proxy (Maybe a) -> Bool
getTypeScriptOptional Proxy (Maybe a)
_ = Bool
True
  getParentTypes :: Proxy (Maybe a) -> [TSType]
getParentTypes Proxy (Maybe a)
_ = [Proxy a -> TSType
forall k (a :: k). (Typeable a, TypeScript a) => Proxy a -> TSType
TSType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)]

instance TypeScript A.Value where
  getTypeScriptType :: Proxy Value -> String
getTypeScriptType Proxy Value
_ = String
"any";

instance (TypeScript a, TypeScript b) => TypeScript (HashMap a b) where
  getTypeScriptType :: Proxy (HashMap a b) -> String
getTypeScriptType Proxy (HashMap a b)
_ = [i|{[k: #{getTypeScriptType (Proxy :: Proxy a)}]: #{getTypeScriptType (Proxy :: Proxy b)}}|]
  getParentTypes :: Proxy (HashMap a b) -> [TSType]
getParentTypes Proxy (HashMap a b)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub ((Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
                            [TSType] -> [TSType] -> [TSType]
forall a. Semigroup a => a -> a -> a
<> (Proxy b -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)))

instance (TypeScript a) => TypeScript (Set a) where
  getTypeScriptType :: Proxy (Set a) -> String
getTypeScriptType Proxy (Set a)
_ = Proxy a -> String
forall k (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"[]";
  getParentTypes :: Proxy (Set a) -> [TSType]
getParentTypes Proxy (Set a)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub (Proxy a -> [TSType]
forall k (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))