{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell, RecordWildCards, ScopedTypeVariables, NamedFieldPuns, CPP #-}

module Data.Aeson.TypeScript.Formatting where

import Data.Aeson.TypeScript.Types
import Data.String.Interpolate
import qualified Data.Text as T

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


-- | Same as 'formatTSDeclarations'', but uses default formatting options.
formatTSDeclarations :: [TSDeclaration] -> String
formatTSDeclarations :: [TSDeclaration] -> String
formatTSDeclarations = FormattingOptions -> [TSDeclaration] -> String
formatTSDeclarations' FormattingOptions
defaultFormattingOptions

-- | Format a single TypeScript declaration. This version accepts a FormattingOptions object in case you want more control over the output.
formatTSDeclaration :: FormattingOptions -> TSDeclaration -> String
formatTSDeclaration :: FormattingOptions -> TSDeclaration -> String
formatTSDeclaration (FormattingOptions {Int
SumTypeFormat
ExportMode
String -> String
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
exportMode :: FormattingOptions -> ExportMode
typeNameModifier :: FormattingOptions -> String -> String
interfaceNameModifier :: FormattingOptions -> String -> String
numIndentSpaces :: FormattingOptions -> Int
typeAlternativesFormat :: SumTypeFormat
exportMode :: ExportMode
typeNameModifier :: String -> String
interfaceNameModifier :: String -> String
numIndentSpaces :: Int
..}) (TSTypeAlternatives String
name [String]
genericVariables [String]
names) =
  case SumTypeFormat
typeAlternativesFormat of
    SumTypeFormat
Enum -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnum} }|]
    SumTypeFormat
EnumWithType -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnumWithType} }#{enumType}|]
    SumTypeFormat
TypeAlias -> [i|#{exportPrefix exportMode}type #{typeNameModifier name}#{getGenericBrackets genericVariables} = #{alternatives};|]
  where
    alternatives :: Text
alternatives = Text -> [Text] -> Text
T.intercalate Text
" | " ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack [String]
names)
    alternativesEnum :: Text
alternativesEnum = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text -> Text
toEnumName Text
entry | Text
entry <- String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
names]
    alternativesEnumWithType :: Text
alternativesEnumWithType = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text -> Text
toEnumName Text
entry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entry | Text
entry <- String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
names]
    enumType :: Text
enumType = [i|\n\ntype #{name} = keyof typeof #{typeNameModifier name};|] :: T.Text
    toEnumName :: Text -> Text
toEnumName = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
""

formatTSDeclaration (FormattingOptions {Int
SumTypeFormat
ExportMode
String -> String
typeAlternativesFormat :: SumTypeFormat
exportMode :: ExportMode
typeNameModifier :: String -> String
interfaceNameModifier :: String -> String
numIndentSpaces :: Int
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
exportMode :: FormattingOptions -> ExportMode
typeNameModifier :: FormattingOptions -> String -> String
interfaceNameModifier :: FormattingOptions -> String -> String
numIndentSpaces :: FormattingOptions -> Int
..}) (TSInterfaceDeclaration String
interfaceName [String]
genericVariables [TSField]
members) =
  [i|#{exportPrefix exportMode}interface #{modifiedInterfaceName}#{getGenericBrackets genericVariables} {
#{ls}
}|] where ls :: Text
ls = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack [(Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
numIndentSpaces Char
' ') String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TSField -> String
formatTSField TSField
member String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
";"| TSField
member <- [TSField]
members]
          modifiedInterfaceName :: String
modifiedInterfaceName = (\(String
li, String
name) -> String
li String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
interfaceNameModifier String
name) ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
interfaceName

formatTSDeclaration (FormattingOptions {Int
SumTypeFormat
ExportMode
String -> String
typeAlternativesFormat :: SumTypeFormat
exportMode :: ExportMode
typeNameModifier :: String -> String
interfaceNameModifier :: String -> String
numIndentSpaces :: Int
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
exportMode :: FormattingOptions -> ExportMode
typeNameModifier :: FormattingOptions -> String -> String
interfaceNameModifier :: FormattingOptions -> String -> String
numIndentSpaces :: FormattingOptions -> Int
..}) (TSRawDeclaration String
text) = String
text

exportPrefix :: ExportMode -> String
exportPrefix :: ExportMode -> String
exportPrefix ExportMode
ExportEach = String
"export "
exportPrefix ExportMode
ExportNone = String
""

-- | Format a list of TypeScript declarations into a string, suitable for putting directly into a @.d.ts@ file.
formatTSDeclarations' :: FormattingOptions -> [TSDeclaration] -> String
formatTSDeclarations' :: FormattingOptions -> [TSDeclaration] -> String
formatTSDeclarations' FormattingOptions
options [TSDeclaration]
declarations = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n\n" ((TSDeclaration -> Text) -> [TSDeclaration] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text)
-> (TSDeclaration -> String) -> TSDeclaration -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattingOptions -> TSDeclaration -> String
formatTSDeclaration (FormattingOptions -> [TSDeclaration] -> FormattingOptions
validateFormattingOptions FormattingOptions
options [TSDeclaration]
declarations)) [TSDeclaration]
declarations)

validateFormattingOptions :: FormattingOptions -> [TSDeclaration] -> FormattingOptions
validateFormattingOptions :: FormattingOptions -> [TSDeclaration] -> FormattingOptions
validateFormattingOptions options :: FormattingOptions
options@FormattingOptions{Int
SumTypeFormat
ExportMode
String -> String
typeAlternativesFormat :: SumTypeFormat
exportMode :: ExportMode
typeNameModifier :: String -> String
interfaceNameModifier :: String -> String
numIndentSpaces :: Int
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
exportMode :: FormattingOptions -> ExportMode
typeNameModifier :: FormattingOptions -> String -> String
interfaceNameModifier :: FormattingOptions -> String -> String
numIndentSpaces :: FormattingOptions -> Int
..} [TSDeclaration]
decls
  | SumTypeFormat
typeAlternativesFormat SumTypeFormat -> SumTypeFormat -> Bool
forall a. Eq a => a -> a -> Bool
== SumTypeFormat
Enum Bool -> Bool -> Bool
&& [TSDeclaration] -> Bool
forall (t :: * -> *). Foldable t => t TSDeclaration -> Bool
isPlainSumType [TSDeclaration]
decls = FormattingOptions
options
  | SumTypeFormat
typeAlternativesFormat SumTypeFormat -> SumTypeFormat -> Bool
forall a. Eq a => a -> a -> Bool
== SumTypeFormat
EnumWithType Bool -> Bool -> Bool
&& [TSDeclaration] -> Bool
forall (t :: * -> *). Foldable t => t TSDeclaration -> Bool
isPlainSumType [TSDeclaration]
decls = FormattingOptions
options { typeNameModifier :: String -> String
typeNameModifier = (String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) String
"Enum" }
  | Bool
otherwise = FormattingOptions
options { typeAlternativesFormat :: SumTypeFormat
typeAlternativesFormat = SumTypeFormat
TypeAlias }
  where
    isInterface :: TSDeclaration -> Bool
    isInterface :: TSDeclaration -> Bool
isInterface TSInterfaceDeclaration{} = Bool
True
    isInterface TSDeclaration
_ = Bool
False

    -- Plain sum types have only one declaration with multiple alternatives
    -- Units (data U = U) contain two declarations, and thus are invalid
    isPlainSumType :: t TSDeclaration -> Bool
isPlainSumType t TSDeclaration
ds = (Bool -> Bool
not (Bool -> Bool)
-> (t TSDeclaration -> Bool) -> t TSDeclaration -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TSDeclaration -> Bool) -> t TSDeclaration -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TSDeclaration -> Bool
isInterface (t TSDeclaration -> Bool) -> t TSDeclaration -> Bool
forall a b. (a -> b) -> a -> b
$ t TSDeclaration
ds) Bool -> Bool -> Bool
&& t TSDeclaration -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t TSDeclaration
ds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

formatTSField :: TSField -> String
formatTSField :: TSField -> String
formatTSField (TSField Bool
optional String
name String
typ) = [i|#{name}#{if optional then ("?" :: String) else ""}: #{typ}|]

getGenericBrackets :: [String] -> String
getGenericBrackets :: [String] -> String
getGenericBrackets [] = String
""
getGenericBrackets [String]
xs = [i|<#{T.intercalate ", " (fmap T.pack xs)}>|]