{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PolyKinds #-}
{-# 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.Functor.Compose (Compose)
import Data.Functor.Const (Const)
import Data.Functor.Identity (Identity)
import Data.Functor.Product (Product)
import Data.HashMap.Strict
import Data.HashSet
import Data.Kind (Type)
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict
import Data.Set
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Void
import Data.Word
import GHC.Int
import Numeric.Natural (Natural)

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

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as A
#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 Natural where
  getTypeScriptType :: Proxy Natural -> String
getTypeScriptType Proxy Natural
_ = 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 Int16 where
  getTypeScriptType :: Proxy Int16 -> String
getTypeScriptType Proxy Int16
_ = String
"number"

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

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

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

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

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

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

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

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

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

instance (TypeScript a) => TypeScript (NonEmpty a) where
  getTypeScriptType :: Proxy (NonEmpty a) -> String
getTypeScriptType Proxy (NonEmpty 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])
  getParentTypes :: Proxy (NonEmpty a) -> [TSType]
getParentTypes Proxy (NonEmpty 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 {-# 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] -> Maybe String -> TSDeclaration
TSTypeAlternatives String
"Either" [String
"T1", String
"T2"] [String
"Left<T1>", String
"Right<T2>"] Maybe String
forall a. Maybe a
Nothing
                               , String -> [String] -> [TSField] -> Maybe String -> TSDeclaration
TSInterfaceDeclaration String
"Left" [String
"T"] [Bool -> String -> String -> Maybe String -> TSField
TSField Bool
False String
"Left" String
"T" Maybe String
forall a. Maybe a
Nothing] Maybe String
forall a. Maybe a
Nothing
                               , String -> [String] -> [TSField] -> Maybe String -> TSDeclaration
TSInterfaceDeclaration String
"Right" [String
"T"] [Bool -> String -> String -> Maybe String -> TSField
TSField Bool
False String
"Right" String
"T" Maybe String
forall a. Maybe a
Nothing] Maybe String
forall a. Maybe a
Nothing
                               ]
  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))
                           , (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))
                           ]

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))
                           , (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))
                           ]

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))
                           , (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))
                           , (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))
                           ]

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))
                           , (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))
                           , (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))
                           , (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))
                           ]

instance forall a k (b :: k). (Typeable k, Typeable b, TypeScript a) => TypeScript (Const a b) where
  getTypeScriptType :: Proxy (Const a b) -> String
getTypeScriptType Proxy (Const a b)
_ = Proxy a -> String
forall {k} (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
  getParentTypes :: Proxy (Const a b) -> [TSType]
getParentTypes Proxy (Const a b)
_ = [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) => TypeScript (Identity a) where
  getTypeScriptType :: Proxy (Identity a) -> String
getTypeScriptType Proxy (Identity 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)
  getParentTypes :: Proxy (Identity a) -> [TSType]
getParentTypes Proxy (Identity 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 forall k k1 (f :: k -> Type) (g :: k1 -> k) a. (
  Typeable k, Typeable k1, Typeable f, Typeable g, Typeable a, TypeScript (f (g a)), TypeScript a
  ) => TypeScript (Compose f g a) where
  getTypeScriptType :: Proxy (Compose f g a) -> String
getTypeScriptType Proxy (Compose f g a)
_ = Proxy (f (g a)) -> String
forall {k} (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy (f (g a))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f (g a)))
  getParentTypes :: Proxy (Compose f g a) -> [TSType]
getParentTypes Proxy (Compose f g a)
_ = Proxy (f (g a)) -> [TSType]
forall {k} (a :: k). TypeScript a => Proxy a -> [TSType]
getParentTypes (Proxy (f (g a))
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f (g a)))

instance forall k (f :: k -> Type) (g :: k -> Type) a. (
  Typeable k, Typeable f, Typeable g, Typeable a, TypeScript (f a), TypeScript (g a)
  ) => TypeScript (Product f g a) where
  getTypeScriptType :: Proxy (Product f g a) -> String
getTypeScriptType Proxy (Product f g a)
_ = Proxy (f a, g a) -> String
forall {k} (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy (f a, g a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a, g a))
  getParentTypes :: Proxy (Product f g a) -> [TSType]
getParentTypes Proxy (Product f g a)
_ = [TSType] -> [TSType]
forall a. Eq a => [a] -> [a]
L.nub [ (Proxy (f a) -> TSType
forall {k} (a :: k).
(Typeable a, TypeScript a) =>
Proxy a -> TSType
TSType (Proxy (f a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (f a)))
                           , (Proxy (g a) -> TSType
forall {k} (a :: k).
(Typeable a, TypeScript a) =>
Proxy a -> TSType
TSType (Proxy (g a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (g a)))
                           ]

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 (Map a b) where
  getTypeScriptType :: Proxy (Map a b) -> String
getTypeScriptType Proxy (Map a b)
_ = String
"{[k in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy a -> String
forall {k} (a :: k). TypeScript a => Proxy a -> String
getTypeScriptKeyType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]?: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy b -> String
forall {k} (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  getParentTypes :: Proxy (Map a b) -> [TSType]
getParentTypes Proxy (Map a b)
_ = [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), 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)]

instance (TypeScript a, TypeScript b) => TypeScript (HashMap a b) where
  getTypeScriptType :: Proxy (HashMap a b) -> String
getTypeScriptType Proxy (HashMap a b)
_ = [i|{[k in #{getTypeScriptKeyType (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).
(Typeable a, TypeScript a) =>
Proxy a -> TSType
TSType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy 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)]

#if MIN_VERSION_aeson(2,0,0)
instance (TypeScript a) => TypeScript (A.KeyMap a) where
  getTypeScriptType :: Proxy (KeyMap a) -> String
getTypeScriptType Proxy (KeyMap a)
_ = [i|{[k: string]: #{getTypeScriptType (Proxy :: Proxy a)}}|]
  getParentTypes :: Proxy (KeyMap a) -> [TSType]
getParentTypes Proxy (KeyMap a)
_ = [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)]
#endif

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)
_ = [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) => TypeScript (HashSet a) where
  getTypeScriptType :: Proxy (HashSet a) -> String
getTypeScriptType Proxy (HashSet 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 (HashSet a) -> [TSType]
getParentTypes Proxy (HashSet 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)]