{-# LANGUAGE CPP #-}

module Data.Aeson.TypeScript.Formatting where

import Data.Aeson.TypeScript.Types
import Data.Function ((&))
import qualified Data.List as L
import Data.Maybe
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 Maybe String
maybeDoc) =
  Maybe String -> String
makeDocPrefix Maybe String
maybeDoc forall a. Semigroup a => a -> a -> a
<> String
mainDeclaration
  where
    mainDeclaration :: String
mainDeclaration = 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};|]

    alternatives :: Text
alternatives = Text -> [Text] -> Text
T.intercalate 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
", " forall a b. (a -> b) -> a -> b
$ [Text -> Text
toEnumName Text
entry | Text
entry <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
names]
    alternativesEnumWithType :: Text
alternativesEnumWithType = Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ [Text -> Text
toEnumName Text
entry forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
entry | Text
entry <- String -> Text
T.pack 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 (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSField -> Bool
isNoEmitTypeScriptField) -> [TSField]
members) Maybe String
maybeDoc) =
  Maybe String -> String
makeDocPrefix Maybe String
maybeDoc forall a. Semigroup a => a -> a -> a
<> [i|#{exportPrefix exportMode}interface #{modifiedInterfaceName}#{getGenericBrackets genericVariables} {
#{ls}
}|] where
      ls :: Text
ls = Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ [Int -> Text -> Text
indentTo Int
numIndentSpaces (String -> Text
T.pack (TSField -> String
formatTSField TSField
member forall a. Semigroup a => a -> a -> a
<> String
";")) | TSField
member <- [TSField]
members]
      modifiedInterfaceName :: String
modifiedInterfaceName = (\(String
li, String
name) -> String
li forall a. Semigroup a => a -> a -> a
<> String -> String
interfaceNameModifier String
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 forall a b. (a -> b) -> a -> b
$ String
interfaceName

formatTSDeclaration FormattingOptions
_ (TSRawDeclaration String
text) = String
text

indentTo :: Int -> T.Text -> T.Text
indentTo :: Int -> Text -> Text
indentTo Int
numIndentSpaces Text
input = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text
padding forall a. Semigroup a => a -> a -> a
<> Text
line | Text
line <- Text -> Text -> [Text]
T.splitOn Text
"\n" Text
input]
  where padding :: Text
padding = Int -> Text -> Text
T.replicate Int
numIndentSpaces 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]
allDeclarations =
  [TSDeclaration]
declarations forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattingOptions -> TSDeclaration -> String
formatTSDeclaration (FormattingOptions -> [TSDeclaration] -> FormattingOptions
validateFormattingOptions FormattingOptions
options [TSDeclaration]
declarations))
               forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n\n"
               forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack
  where
    removedDeclarations :: [TSDeclaration]
removedDeclarations = forall a. (a -> Bool) -> [a] -> [a]
filter TSDeclaration -> Bool
isNoEmitTypeScriptDeclaration [TSDeclaration]
allDeclarations

    getDeclarationName :: TSDeclaration -> Maybe String
    getDeclarationName :: TSDeclaration -> Maybe String
getDeclarationName (TSInterfaceDeclaration {String
[String]
[TSField]
Maybe String
interfaceDoc :: TSDeclaration -> Maybe String
interfaceMembers :: TSDeclaration -> [TSField]
interfaceGenericVariables :: TSDeclaration -> [String]
interfaceName :: TSDeclaration -> String
interfaceDoc :: Maybe String
interfaceMembers :: [TSField]
interfaceGenericVariables :: [String]
interfaceName :: String
..}) = forall a. a -> Maybe a
Just String
interfaceName
    getDeclarationName (TSTypeAlternatives {String
[String]
Maybe String
typeDoc :: TSDeclaration -> Maybe String
alternativeTypes :: TSDeclaration -> [String]
typeGenericVariables :: TSDeclaration -> [String]
typeName :: TSDeclaration -> String
typeDoc :: Maybe String
alternativeTypes :: [String]
typeGenericVariables :: [String]
typeName :: String
..}) = forall a. a -> Maybe a
Just String
typeName
    Maybe Any
_ = forall a. Maybe a
Nothing

    removedDeclarationNames :: [String]
removedDeclarationNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TSDeclaration -> Maybe String
getDeclarationName [TSDeclaration]
removedDeclarations

    removeReferencesToRemovedNames :: [String] -> TSDeclaration -> TSDeclaration
    removeReferencesToRemovedNames :: [String] -> TSDeclaration -> TSDeclaration
removeReferencesToRemovedNames [String]
removedNames decl :: TSDeclaration
decl@(TSTypeAlternatives {String
[String]
Maybe String
typeDoc :: Maybe String
alternativeTypes :: [String]
typeGenericVariables :: [String]
typeName :: String
typeDoc :: TSDeclaration -> Maybe String
alternativeTypes :: TSDeclaration -> [String]
typeGenericVariables :: TSDeclaration -> [String]
typeName :: TSDeclaration -> String
..}) = TSDeclaration
decl { alternativeTypes :: [String]
alternativeTypes = [String
x | String
x <- [String]
alternativeTypes, Bool -> Bool
not (String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [String]
removedNames)] }
    removeReferencesToRemovedNames [String]
_ TSDeclaration
x = TSDeclaration
x

    declarations :: [TSDeclaration]
declarations = [TSDeclaration]
allDeclarations
                 forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSDeclaration -> Bool
isNoEmitTypeScriptDeclaration)
                 forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> TSDeclaration -> TSDeclaration
removeReferencesToRemovedNames [String]
removedDeclarationNames)

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 forall a. Eq a => a -> a -> Bool
== SumTypeFormat
Enum Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t TSDeclaration -> Bool
isPlainSumType [TSDeclaration]
decls = FormattingOptions
options
  | SumTypeFormat
typeAlternativesFormat forall a. Eq a => a -> a -> Bool
== SumTypeFormat
EnumWithType Bool -> Bool -> Bool
&& forall {t :: * -> *}. Foldable t => t TSDeclaration -> Bool
isPlainSumType [TSDeclaration]
decls = FormattingOptions
options { typeNameModifier :: String -> String
typeNameModifier = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TSDeclaration -> Bool
isInterface forall a b. (a -> b) -> a -> b
$ t TSDeclaration
ds) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length t TSDeclaration
ds forall a. Eq a => a -> a -> Bool
== Int
1

formatTSField :: TSField -> String
formatTSField :: TSField -> String
formatTSField (TSField Bool
optional String
name String
typ Maybe String
maybeDoc) = Maybe String -> String
makeDocPrefix Maybe String
maybeDoc forall a. Semigroup a => a -> a -> a
<> [i|#{name}#{if optional then ("?" :: String) else ""}: #{typ}|]

makeDocPrefix :: Maybe String -> String
makeDocPrefix :: Maybe String -> String
makeDocPrefix Maybe String
maybeDoc = case Maybe String
maybeDoc of
  Maybe String
Nothing -> String
""
  Just (String -> Text
T.pack -> Text
text) -> [Text
"// " forall a. Semigroup a => a -> a -> a
<> Text
line | Text
line <- Text -> Text -> [Text]
T.splitOn Text
"\n" Text
text]
                        forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n"
                        forall a b. a -> (a -> b) -> b
& (forall a. Semigroup a => a -> a -> a
<> Text
"\n")
                        forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack

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

-- * Support for @no-emit-typescript

noEmitTypeScriptAnnotation :: String
noEmitTypeScriptAnnotation :: String
noEmitTypeScriptAnnotation = String
"@no-emit-typescript"

isNoEmitTypeScriptField :: TSField -> Bool
isNoEmitTypeScriptField (TSField {fieldDoc :: TSField -> Maybe String
fieldDoc=(Just String
doc)}) = String
noEmitTypeScriptAnnotation forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
doc
isNoEmitTypeScriptField TSField
_ = Bool
False

isNoEmitTypeScriptDeclaration :: TSDeclaration -> Bool
isNoEmitTypeScriptDeclaration (TSInterfaceDeclaration {interfaceDoc :: TSDeclaration -> Maybe String
interfaceDoc=(Just String
doc)}) = String
noEmitTypeScriptAnnotation forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
doc
isNoEmitTypeScriptDeclaration (TSTypeAlternatives {typeDoc :: TSDeclaration -> Maybe String
typeDoc=(Just String
doc)}) = String
noEmitTypeScriptAnnotation forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
doc
isNoEmitTypeScriptDeclaration TSDeclaration
_ = Bool
False