{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}

module Data.Aeson.TypeScript.Types where

import qualified Data.Aeson as A
import Data.Aeson.TypeScript.LegalName
import Data.Function ((&))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy
import Data.String
import qualified Data.Text as T
import Data.Typeable
import Language.Haskell.TH

-- | The typeclass that defines how a type is turned into TypeScript.
--
-- The 'getTypeScriptDeclarations' method describes the top-level declarations that are needed for a type,
-- while 'getTypeScriptType' describes how references to the type should be translated. The 'getTypeScriptOptional'
-- method exists purely so that 'Maybe' types can be encoded with a question mark.
--
--  Instances for common types are built-in and are usually very simple; for example,
--
-- @
-- instance TypeScript Bool where
--   getTypeScriptType _ = "boolean"
-- @
--
-- Most of the time you should not need to write instances by hand; in fact, the 'TSDeclaration'
-- constructors are deliberately opaque. However, you may occasionally need to specify the type of something.
-- For example, since 'UTCTime' is encoded to a JSON string and is not built-in to this library:
--
-- @
-- import Data.Time.Clock (UTCTime)
--
-- instance TypeScript UTCTime where
--   getTypeScriptType _ = "string"
-- @
--
-- If you need to write a definition for a higher-order type, it may depend on a type parameter. For example,
-- a 'Set' is encoded to a JSON list of the underlying type:
--
-- @
-- instance (TypeScript a) => TypeScript (Set a) where
--   getTypeScriptType _ = getTypeScriptType (Proxy :: Proxy a) <> "[]";
-- @
class (Typeable a) => TypeScript a where
  getTypeScriptDeclarations :: Proxy a -> [TSDeclaration]
  -- ^ Get the declaration(s) needed for this type.
  getTypeScriptDeclarations Proxy a
_ = []

  getTypeScriptType :: Proxy a -> String
  -- ^ Get the type as a string.

  getTypeScriptKeyType :: Proxy a -> String
  getTypeScriptKeyType Proxy a
proxy = forall {k} (a :: k). TypeScript a => Proxy a -> [Char]
getTypeScriptType Proxy a
proxy
  -- ^ Get the key type as a string.

  getTypeScriptOptional :: Proxy a -> Bool
  -- ^ Get a flag representing whether this type is optional.
  getTypeScriptOptional Proxy a
_ = Bool
False

  getParentTypes :: Proxy a -> [TSType]
  -- ^ Get the types that this type depends on. This is useful for generating transitive closures of necessary types.
  getParentTypes Proxy a
_ = []

  isGenericVariable :: Proxy a -> Bool
  -- ^ Special flag to indicate whether this type corresponds to a template variable.
  isGenericVariable Proxy a
_ = Bool
False

-- | An existential wrapper for any TypeScript instance.
data TSType = forall a. (Typeable a, TypeScript a) => TSType { ()
unTSType :: Proxy a }

instance Eq TSType where
  (TSType Proxy a
p1) == :: TSType -> TSType -> Bool
== (TSType Proxy a
p2) = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p1 forall a. Eq a => a -> a -> Bool
== forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p2

instance Ord TSType where
  (TSType Proxy a
p1) compare :: TSType -> TSType -> Ordering
`compare` (TSType Proxy a
p2) = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p1 forall a. Ord a => a -> a -> Ordering
`compare` forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p2

instance Show TSType where
  show :: TSType -> [Char]
show (TSType Proxy a
proxy) = forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
proxy

data TSDeclaration = TSInterfaceDeclaration { TSDeclaration -> [Char]
interfaceName :: String
                                            , TSDeclaration -> [[Char]]
interfaceGenericVariables :: [String]
                                            , TSDeclaration -> [TSField]
interfaceMembers :: [TSField]
                                            , TSDeclaration -> Maybe [Char]
interfaceDoc :: Maybe String }
                   | TSTypeAlternatives { TSDeclaration -> [Char]
typeName :: String
                                        , TSDeclaration -> [[Char]]
typeGenericVariables :: [String]
                                        , TSDeclaration -> [[Char]]
alternativeTypes :: [String]
                                        , TSDeclaration -> Maybe [Char]
typeDoc :: Maybe String }
                   | TSRawDeclaration { TSDeclaration -> [Char]
text :: String }
  deriving (Int -> TSDeclaration -> ShowS
[TSDeclaration] -> ShowS
TSDeclaration -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TSDeclaration] -> ShowS
$cshowList :: [TSDeclaration] -> ShowS
show :: TSDeclaration -> [Char]
$cshow :: TSDeclaration -> [Char]
showsPrec :: Int -> TSDeclaration -> ShowS
$cshowsPrec :: Int -> TSDeclaration -> ShowS
Show, TSDeclaration -> TSDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TSDeclaration -> TSDeclaration -> Bool
$c/= :: TSDeclaration -> TSDeclaration -> Bool
== :: TSDeclaration -> TSDeclaration -> Bool
$c== :: TSDeclaration -> TSDeclaration -> Bool
Eq, Eq TSDeclaration
TSDeclaration -> TSDeclaration -> Bool
TSDeclaration -> TSDeclaration -> Ordering
TSDeclaration -> TSDeclaration -> TSDeclaration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TSDeclaration -> TSDeclaration -> TSDeclaration
$cmin :: TSDeclaration -> TSDeclaration -> TSDeclaration
max :: TSDeclaration -> TSDeclaration -> TSDeclaration
$cmax :: TSDeclaration -> TSDeclaration -> TSDeclaration
>= :: TSDeclaration -> TSDeclaration -> Bool
$c>= :: TSDeclaration -> TSDeclaration -> Bool
> :: TSDeclaration -> TSDeclaration -> Bool
$c> :: TSDeclaration -> TSDeclaration -> Bool
<= :: TSDeclaration -> TSDeclaration -> Bool
$c<= :: TSDeclaration -> TSDeclaration -> Bool
< :: TSDeclaration -> TSDeclaration -> Bool
$c< :: TSDeclaration -> TSDeclaration -> Bool
compare :: TSDeclaration -> TSDeclaration -> Ordering
$ccompare :: TSDeclaration -> TSDeclaration -> Ordering
Ord)

data TSField = TSField
  { TSField -> Bool
fieldOptional :: Bool
  , TSField -> [Char]
fieldName :: String
  , TSField -> [Char]
fieldType :: String
  , TSField -> Maybe [Char]
fieldDoc :: Maybe String
  -- ^ Haddock documentation for the field, if present
  } deriving (Int -> TSField -> ShowS
[TSField] -> ShowS
TSField -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TSField] -> ShowS
$cshowList :: [TSField] -> ShowS
show :: TSField -> [Char]
$cshow :: TSField -> [Char]
showsPrec :: Int -> TSField -> ShowS
$cshowsPrec :: Int -> TSField -> ShowS
Show, TSField -> TSField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TSField -> TSField -> Bool
$c/= :: TSField -> TSField -> Bool
== :: TSField -> TSField -> Bool
$c== :: TSField -> TSField -> Bool
Eq, Eq TSField
TSField -> TSField -> Bool
TSField -> TSField -> Ordering
TSField -> TSField -> TSField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TSField -> TSField -> TSField
$cmin :: TSField -> TSField -> TSField
max :: TSField -> TSField -> TSField
$cmax :: TSField -> TSField -> TSField
>= :: TSField -> TSField -> Bool
$c>= :: TSField -> TSField -> Bool
> :: TSField -> TSField -> Bool
$c> :: TSField -> TSField -> Bool
<= :: TSField -> TSField -> Bool
$c<= :: TSField -> TSField -> Bool
< :: TSField -> TSField -> Bool
$c< :: TSField -> TSField -> Bool
compare :: TSField -> TSField -> Ordering
$ccompare :: TSField -> TSField -> Ordering
Ord)

newtype TSString a = TSString { forall {k} (a :: k). TSString a -> [Char]
unpackTSString :: String } deriving Int -> TSString a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> TSString a -> ShowS
forall k (a :: k). [TSString a] -> ShowS
forall {k} (a :: k). TSString a -> [Char]
showList :: [TSString a] -> ShowS
$cshowList :: forall k (a :: k). [TSString a] -> ShowS
show :: TSString a -> [Char]
$cshow :: forall {k} (a :: k). TSString a -> [Char]
showsPrec :: Int -> TSString a -> ShowS
$cshowsPrec :: forall k (a :: k). Int -> TSString a -> ShowS
Show

instance IsString (TSString a) where
  fromString :: [Char] -> TSString a
fromString = forall k (a :: k). [Char] -> TSString a
TSString

-- * Formatting options

data FormattingOptions = FormattingOptions
  { FormattingOptions -> Int
numIndentSpaces       :: Int
  -- ^ How many spaces to indent TypeScript blocks
  , FormattingOptions -> ShowS
interfaceNameModifier :: String -> String
  -- ^ Function applied to generated interface names
  , FormattingOptions -> ShowS
typeNameModifier :: String -> String
  -- ^ Function applied to generated type names
  , FormattingOptions -> ExportMode
exportMode :: ExportMode
  -- ^ Whether to include the export keyword in declarations
  , FormattingOptions -> SumTypeFormat
typeAlternativesFormat :: SumTypeFormat
  -- ^ How to format the declaration of the alternatives when multiple constructors exist
  }

data ExportMode =
  ExportEach
  -- ^ Prefix every declaration with the "export" keyword (suitable for putting in a TypeScripe module)
  | ExportNone
  -- ^ No exporting (suitable for putting in a .d.ts file)

-- | TODO: docstrings here
data SumTypeFormat =
  TypeAlias
  | Enum
  | EnumWithType
  deriving (SumTypeFormat -> SumTypeFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumTypeFormat -> SumTypeFormat -> Bool
$c/= :: SumTypeFormat -> SumTypeFormat -> Bool
== :: SumTypeFormat -> SumTypeFormat -> Bool
$c== :: SumTypeFormat -> SumTypeFormat -> Bool
Eq, Int -> SumTypeFormat -> ShowS
[SumTypeFormat] -> ShowS
SumTypeFormat -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SumTypeFormat] -> ShowS
$cshowList :: [SumTypeFormat] -> ShowS
show :: SumTypeFormat -> [Char]
$cshow :: SumTypeFormat -> [Char]
showsPrec :: Int -> SumTypeFormat -> ShowS
$cshowsPrec :: Int -> SumTypeFormat -> ShowS
Show)

defaultFormattingOptions :: FormattingOptions
defaultFormattingOptions :: FormattingOptions
defaultFormattingOptions = FormattingOptions
  { numIndentSpaces :: Int
numIndentSpaces = Int
2
  , interfaceNameModifier :: ShowS
interfaceNameModifier = ShowS
defaultNameFormatter
  , typeNameModifier :: ShowS
typeNameModifier = ShowS
defaultNameFormatter
  , exportMode :: ExportMode
exportMode = ExportMode
ExportNone
  , typeAlternativesFormat :: SumTypeFormat
typeAlternativesFormat = SumTypeFormat
TypeAlias
  }

-- | The 'defaultNameFormatter' in the 'FormattingOptions' checks to see if
-- the name is a legal TypeScript name. If it is not, then it throws
-- a runtime error.
defaultNameFormatter :: String -> String
defaultNameFormatter :: ShowS
defaultNameFormatter [Char]
str =
  case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [Char]
str of
    Maybe (NonEmpty Char)
Nothing ->
      forall a. HasCallStack => [Char] -> a
error [Char]
"Name cannot be empty"
    Just NonEmpty Char
nameChars ->
      case NonEmpty Char -> Maybe (NonEmpty Char)
checkIllegalNameChars NonEmpty Char
nameChars of
        Just NonEmpty Char
badChars ->
          forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"The name ", [Char]
str, [Char]
" contains illegal characters: ", forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Char
badChars
            , [Char]
"\nConsider setting a default name formatter that replaces these characters, or renaming the type."
            ]
        Maybe (NonEmpty Char)
Nothing ->
          [Char]
str

-- | Convenience typeclass class you can use to "attach" a set of Aeson encoding options to a type.
class HasJSONOptions a where
  getJSONOptions :: (Proxy a) -> A.Options

data T = T
data T1 = T1
data T2 = T2
data T3 = T3
data T4 = T4
data T5 = T5
data T6 = T6
data T7 = T7
data T8 = T8
data T9 = T9
data T10 = T10

instance TypeScript T where getTypeScriptType :: Proxy T -> [Char]
getTypeScriptType Proxy T
_ = [Char]
"T"; isGenericVariable :: Proxy T -> Bool
isGenericVariable Proxy T
_ = Bool
True
instance TypeScript T1 where getTypeScriptType :: Proxy T1 -> [Char]
getTypeScriptType Proxy T1
_ = [Char]
"T1"; isGenericVariable :: Proxy T1 -> Bool
isGenericVariable Proxy T1
_ = Bool
True
instance TypeScript T2 where getTypeScriptType :: Proxy T2 -> [Char]
getTypeScriptType Proxy T2
_ = [Char]
"T2"; isGenericVariable :: Proxy T2 -> Bool
isGenericVariable Proxy T2
_ = Bool
True
instance TypeScript T3 where getTypeScriptType :: Proxy T3 -> [Char]
getTypeScriptType Proxy T3
_ = [Char]
"T3"; isGenericVariable :: Proxy T3 -> Bool
isGenericVariable Proxy T3
_ = Bool
True
instance TypeScript T4 where getTypeScriptType :: Proxy T4 -> [Char]
getTypeScriptType Proxy T4
_ = [Char]
"T4"; isGenericVariable :: Proxy T4 -> Bool
isGenericVariable Proxy T4
_ = Bool
True
instance TypeScript T5 where getTypeScriptType :: Proxy T5 -> [Char]
getTypeScriptType Proxy T5
_ = [Char]
"T5"; isGenericVariable :: Proxy T5 -> Bool
isGenericVariable Proxy T5
_ = Bool
True
instance TypeScript T6 where getTypeScriptType :: Proxy T6 -> [Char]
getTypeScriptType Proxy T6
_ = [Char]
"T6"; isGenericVariable :: Proxy T6 -> Bool
isGenericVariable Proxy T6
_ = Bool
True
instance TypeScript T7 where getTypeScriptType :: Proxy T7 -> [Char]
getTypeScriptType Proxy T7
_ = [Char]
"T7"; isGenericVariable :: Proxy T7 -> Bool
isGenericVariable Proxy T7
_ = Bool
True
instance TypeScript T8 where getTypeScriptType :: Proxy T8 -> [Char]
getTypeScriptType Proxy T8
_ = [Char]
"T8"; isGenericVariable :: Proxy T8 -> Bool
isGenericVariable Proxy T8
_ = Bool
True
instance TypeScript T9 where getTypeScriptType :: Proxy T9 -> [Char]
getTypeScriptType Proxy T9
_ = [Char]
"T9"; isGenericVariable :: Proxy T9 -> Bool
isGenericVariable Proxy T9
_ = Bool
True
instance TypeScript T10 where getTypeScriptType :: Proxy T10 -> [Char]
getTypeScriptType Proxy T10
_ = [Char]
"T10"; isGenericVariable :: Proxy T10 -> Bool
isGenericVariable Proxy T10
_ = Bool
True

allStarConstructors :: [Type]
allStarConstructors :: [Type]
allStarConstructors = [Name -> Type
ConT ''T1, Name -> Type
ConT ''T2, Name -> Type
ConT ''T3, Name -> Type
ConT ''T4, Name -> Type
ConT ''T5, Name -> Type
ConT ''T6, Name -> Type
ConT ''T7, Name -> Type
ConT ''T8, Name -> Type
ConT ''T9, Name -> Type
ConT ''T10]

allStarConstructors' :: [Name]
allStarConstructors' :: [Name]
allStarConstructors' = [''T1, ''T2, ''T3, ''T4, ''T5, ''T6, ''T7, ''T8, ''T9, ''T10]

allStarConstructors'' :: [String]
allStarConstructors'' :: [[Char]]
allStarConstructors'' = [[Char]
"T1", [Char]
"T2", [Char]
"T3", [Char]
"T4", [Char]
"T5", [Char]
"T6", [Char]
"T7", [Char]
"T8", [Char]
"T9", [Char]
"T10"]

-- | Type variable gathering

data ExtraTypeScriptOptions = ExtraTypeScriptOptions {
  ExtraTypeScriptOptions -> [Name]
typeFamiliesToMapToTypeScript :: [Name]

  , ExtraTypeScriptOptions -> Maybe [Char]
keyType :: Maybe String

  -- | Function which is applied to all Haddocks we read in.
  -- By default, just drops leading whitespace from each line.
  , ExtraTypeScriptOptions -> ShowS
haddockModifier :: String -> String
  }

defaultExtraTypeScriptOptions :: ExtraTypeScriptOptions
defaultExtraTypeScriptOptions :: ExtraTypeScriptOptions
defaultExtraTypeScriptOptions = [Name] -> Maybe [Char] -> ShowS -> ExtraTypeScriptOptions
ExtraTypeScriptOptions [] forall a. Maybe a
Nothing ShowS
stripStartEachLine
  where
    stripStartEachLine :: String -> String
    stripStartEachLine :: ShowS
stripStartEachLine [Char]
s = [Char]
s
                         forall a b. a -> (a -> b) -> b
& [Char] -> Text
T.pack
                         forall a b. a -> (a -> b) -> b
& Text -> Text -> [Text]
T.splitOn Text
"\n"
                         forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.stripStart
                         forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n"
                         forall a b. a -> (a -> b) -> b
& Text -> [Char]
T.unpack

data ExtraDeclOrGenericInfo = ExtraDecl Exp
                            | ExtraGeneric GenericInfo
                            | ExtraTopLevelDecs [Dec]
                            | ExtraConstraint Type
                            | ExtraParentType Type
  deriving Int -> ExtraDeclOrGenericInfo -> ShowS
[ExtraDeclOrGenericInfo] -> ShowS
ExtraDeclOrGenericInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExtraDeclOrGenericInfo] -> ShowS
$cshowList :: [ExtraDeclOrGenericInfo] -> ShowS
show :: ExtraDeclOrGenericInfo -> [Char]
$cshow :: ExtraDeclOrGenericInfo -> [Char]
showsPrec :: Int -> ExtraDeclOrGenericInfo -> ShowS
$cshowsPrec :: Int -> ExtraDeclOrGenericInfo -> ShowS
Show

data GenericInfo = GenericInfo Name GenericInfoExtra
  deriving Int -> GenericInfo -> ShowS
[GenericInfo] -> ShowS
GenericInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GenericInfo] -> ShowS
$cshowList :: [GenericInfo] -> ShowS
show :: GenericInfo -> [Char]
$cshow :: GenericInfo -> [Char]
showsPrec :: Int -> GenericInfo -> ShowS
$cshowsPrec :: Int -> GenericInfo -> ShowS
Show

data GenericInfoExtra = NormalStar
                      | TypeFamilyKey Name
  deriving Int -> GenericInfoExtra -> ShowS
[GenericInfoExtra] -> ShowS
GenericInfoExtra -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GenericInfoExtra] -> ShowS
$cshowList :: [GenericInfoExtra] -> ShowS
show :: GenericInfoExtra -> [Char]
$cshow :: GenericInfoExtra -> [Char]
showsPrec :: Int -> GenericInfoExtra -> ShowS
$cshowsPrec :: Int -> GenericInfoExtra -> ShowS
Show