{-# LANGUAGE CPP #-}

module Data.Aeson.TypeScript.Formatting where

import Data.Aeson as A
import Data.Aeson.TypeScript.Types
import qualified Data.ByteString.Lazy.Char8 as BL8
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
numIndentSpaces :: Int
interfaceNameModifier :: String -> String
typeNameModifier :: String -> String
exportMode :: ExportMode
typeAlternativesFormat :: SumTypeFormat
numIndentSpaces :: FormattingOptions -> Int
interfaceNameModifier :: FormattingOptions -> String -> String
typeNameModifier :: FormattingOptions -> String -> String
exportMode :: FormattingOptions -> ExportMode
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
..}) (TSTypeAlternatives String
name [String]
genericVariables [String]
names Maybe String
maybeDoc) =
  Maybe String -> String
makeDocPrefix Maybe String
maybeDoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
mainDeclaration
  where
    mainDeclaration :: String
mainDeclaration = case SumTypeFormat -> SumTypeFormat
chooseTypeAlternativesFormat SumTypeFormat
typeAlternativesFormat of
      SumTypeFormat
Enum -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name} { #{alternativesEnum} }|]
        where
          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 -> 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]
      SumTypeFormat
EnumWithType -> [i|#{exportPrefix exportMode}enum #{typeNameModifier name}Enum { #{alternativesEnumWithType} }#{enumType}|]
        where
          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}Enum;|] :: T.Text
      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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack [String]
names)

    -- Only allow certain formats if some checks pass
    chooseTypeAlternativesFormat :: SumTypeFormat -> SumTypeFormat
chooseTypeAlternativesFormat SumTypeFormat
Enum
      | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isDoubleQuotedString [String]
names = SumTypeFormat
Enum
      | Bool
otherwise = SumTypeFormat
TypeAlias
    chooseTypeAlternativesFormat SumTypeFormat
EnumWithType
      | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isDoubleQuotedString [String]
names = SumTypeFormat
EnumWithType
      | Bool
otherwise = SumTypeFormat
TypeAlias
    chooseTypeAlternativesFormat SumTypeFormat
x = SumTypeFormat
x

    isDoubleQuotedString :: String -> Bool
isDoubleQuotedString String
s = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (String -> ByteString
BL8.pack String
s) of
      Right (A.String Text
_) -> Bool
True
      Either String Value
_ -> Bool
False

    toEnumName :: Text -> Text
toEnumName = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
""

formatTSDeclaration (FormattingOptions {Int
SumTypeFormat
ExportMode
String -> String
numIndentSpaces :: FormattingOptions -> Int
interfaceNameModifier :: FormattingOptions -> String -> String
typeNameModifier :: FormattingOptions -> String -> String
exportMode :: FormattingOptions -> ExportMode
typeAlternativesFormat :: FormattingOptions -> SumTypeFormat
numIndentSpaces :: Int
interfaceNameModifier :: String -> String
typeNameModifier :: String -> String
exportMode :: ExportMode
typeAlternativesFormat :: SumTypeFormat
..}) (TSInterfaceDeclaration String
interfaceName [String]
genericVariables ((TSField -> Bool) -> [TSField] -> [TSField]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TSField -> Bool) -> TSField -> Bool
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 String -> String -> String
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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Int -> Text -> Text
indentTo Int
numIndentSpaces (String -> Text
T.pack (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

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

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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line | Text
line <- HasCallStack => Text -> Text -> [Text]
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 [TSDeclaration] -> ([TSDeclaration] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TSDeclaration -> Text) -> [TSDeclaration] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
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
options)
               [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n\n"
               Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
T.unpack
  where
    removedDeclarationNames :: [String]
removedDeclarationNames = (TSDeclaration -> Maybe String) -> [TSDeclaration] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TSDeclaration -> Maybe String
getDeclarationName ((TSDeclaration -> Bool) -> [TSDeclaration] -> [TSDeclaration]
forall a. (a -> Bool) -> [a] -> [a]
filter TSDeclaration -> Bool
isNoEmitTypeScriptDeclaration [TSDeclaration]
allDeclarations)
      where
        getDeclarationName :: TSDeclaration -> Maybe String
        getDeclarationName :: TSDeclaration -> Maybe String
getDeclarationName (TSInterfaceDeclaration {String
[String]
[TSField]
Maybe String
interfaceName :: String
interfaceGenericVariables :: [String]
interfaceMembers :: [TSField]
interfaceDoc :: Maybe String
interfaceName :: TSDeclaration -> String
interfaceGenericVariables :: TSDeclaration -> [String]
interfaceMembers :: TSDeclaration -> [TSField]
interfaceDoc :: TSDeclaration -> Maybe String
..}) = String -> Maybe String
forall a. a -> Maybe a
Just String
interfaceName
        getDeclarationName (TSTypeAlternatives {String
[String]
Maybe String
typeName :: String
typeGenericVariables :: [String]
alternativeTypes :: [String]
typeDoc :: Maybe String
typeName :: TSDeclaration -> String
typeGenericVariables :: TSDeclaration -> [String]
alternativeTypes :: TSDeclaration -> [String]
typeDoc :: TSDeclaration -> Maybe String
..}) = String -> Maybe String
forall a. a -> Maybe a
Just String
typeName
        getDeclarationName TSDeclaration
_ = Maybe String
forall a. Maybe a
Nothing

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

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

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
"// " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line | Text
line <- HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"\n" Text
text]
                        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n"
                        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
                        Text -> (Text -> String) -> String
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 -> Bool
isNoEmitTypeScriptField (TSField {fieldDoc :: TSField -> Maybe String
fieldDoc=(Just String
doc)}) = String
noEmitTypeScriptAnnotation String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
doc
isNoEmitTypeScriptField TSField
_ = Bool
False

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