{-# LANGUAGE OverloadedStrings #-}

-- | This module defines a basic AST for generating TypeScript
-- declaration files, and basic pretty-printing functionality.
--
-- The reason we define a custom tool for generating TypeScript
-- declaration files is that existing libraries like `aeson-typescript`
-- and `servant-typescript` are not aimed at generating custom
-- TypeScript interface declaration files for a specific API,
-- but rather at generating TypeScript interfaces for Haskell
-- data types and servant HTTP APIs respectively. And other libraries
-- that align with our needs, like `language-typescript`, are not
-- actively maintained.
module Cardano.Wasm.Api.TypeScriptDefs where

import Data.List.NonEmpty qualified as LNE
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Data.Text.Lazy.IO qualified as TL
import System.FilePath ((</>))

-- | Output the TypeScript declaration files to the specified directory.
writeTypeScriptToDir :: FilePath -> TypeScriptFile -> IO ()
writeTypeScriptToDir :: FilePath -> TypeScriptFile -> IO ()
writeTypeScriptToDir FilePath
dir TypeScriptFile
tsFile = do
  let content :: Builder
content = TypeScriptFile -> Builder
buildTypeScriptFile TypeScriptFile
tsFile
      filePath :: FilePath
filePath = FilePath
dir FilePath -> FilePath -> FilePath
</> TypeScriptFile -> FilePath
typeScriptFileName TypeScriptFile
tsFile
  FilePath -> Text -> IO ()
TL.writeFile FilePath
filePath (Builder -> Text
TLB.toLazyText Builder
content)

-- | Creates a builder for a JavaScript-style multiline comment
-- with the specified indentation level (in spaces) and each line
-- in the list of strings as a separate line in the comment.
-- The first line starts with `/**`, subsequent lines (corresponding
-- to each line in the list) start with ` * `,
-- and the last line ends with ` */`.
-- The indentation level is used to indent the entire comment block.
buildMultilineComment :: Int -> [String] -> TLB.Builder
buildMultilineComment :: Int -> [FilePath] -> Builder
buildMultilineComment Int
indentLevel [FilePath]
commentLines =
  let indentation :: Builder
indentation = Text -> Builder
TLB.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indentLevel) Text
" "
      bodyIndentation :: Builder
bodyIndentation = Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" * "
      firstLine :: Builder
firstLine = Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"/**"
      indentedCommentLines :: [Builder]
indentedCommentLines = (FilePath -> Builder) -> [FilePath] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
line -> (Builder
bodyIndentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> (FilePath -> Builder) -> FilePath -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Builder
TLB.fromString (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath
line FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n") [FilePath]
commentLines
      lastLine :: Builder
lastLine = Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" */"
   in [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
firstLine, Builder
"\n", [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
indentedCommentLines, Builder
lastLine]

-- | Represents the top-level structure of a TypeScript declaration file.
data TypeScriptFile = TypeScriptFile
  { TypeScriptFile -> FilePath
typeScriptFileName :: String
  -- ^ Name of the TypeScript file.
  , TypeScriptFile -> [Declaration]
typeScriptFileContent :: [Declaration]
  -- ^ List of declarations in the file.
  }

-- | Creates a builder for a TypeScript declaration file.
-- It adds a comment to the top of the file with the file name.
buildTypeScriptFile :: TypeScriptFile -> TLB.Builder
buildTypeScriptFile :: TypeScriptFile -> Builder
buildTypeScriptFile (TypeScriptFile FilePath
name [Declaration]
decls) =
  let header :: Builder
header = FilePath -> Builder
TLB.fromString (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath
"// " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
      declarations :: Builder
declarations = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Declaration -> Builder) -> [Declaration] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\Declaration
dec -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Declaration -> Builder
buildDeclaration Declaration
dec Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") [Declaration]
decls
   in Builder
header Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
declarations

-- | Wraps a TypeScript declaration with a comment.
-- The TypeScript declaration can have any of the types
-- defined by 'DeclarationType'.
data Declaration = Declaration
  { Declaration -> [FilePath]
declarationComment :: [String]
  -- ^ Comments for the declaration, can be empty if no comments are needed.
  -- Each element in the list is a separate line in the comment.
  , Declaration -> DeclarationType
declarationContent :: DeclarationType
  -- ^ The type and content of the declaration.
  }

-- | Creates a builder for a TypeScript declaration.
buildDeclaration :: Declaration -> TLB.Builder
buildDeclaration :: Declaration -> Builder
buildDeclaration (Declaration [] DeclarationType
declarationType) = DeclarationType -> Builder
buildDeclarationType DeclarationType
declarationType
buildDeclaration (Declaration [FilePath]
comments DeclarationType
declarationType) =
  Int -> [FilePath] -> Builder
buildMultilineComment Int
0 [FilePath]
comments Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> DeclarationType -> Builder
buildDeclarationType DeclarationType
declarationType

-- | Represents a TypeScript declaration content of some type.
data DeclarationType
  = -- | Export declaration.
    ExportDec
      Bool
      -- ^ Is it a default export?
      String
      -- ^ Name of the symbol to export.
  | -- | Function declaration.
    FunctionDec FunctionHeader
  | -- | Interface declaration.
    InterfaceDec
      String
      -- ^ Name of the interface.
      [GroupedInterfaceContent]
      -- ^ Definitions of the interface.
  | -- | Reference to import another TypeScript declaration file.
    ImportDec
      String
      -- ^ Name of the symbol to import.
      String
      -- ^ Path to the TypeScript declaration file to import.

-- | Creates a builder for a TypeScript declaration type and content.
buildDeclarationType :: DeclarationType -> TLB.Builder
buildDeclarationType :: DeclarationType -> Builder
buildDeclarationType (ExportDec Bool
isDefault FilePath
symbolName) =
  Builder
"export "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (if Bool
isDefault then Builder
"default " else Builder
"")
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
symbolName
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"
buildDeclarationType (FunctionDec FunctionHeader
header) =
  Builder
"declare function " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FunctionHeader -> Builder
buildFunctionHeader FunctionHeader
header Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"
buildDeclarationType (InterfaceDec FilePath
name [GroupedInterfaceContent]
properties) =
  Builder
"declare interface "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
name
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" {"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      ( (GroupedInterfaceContent -> Builder)
-> [GroupedInterfaceContent] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map
          (\GroupedInterfaceContent
content -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> GroupedInterfaceContent -> Builder
buildGroupedInterfaceContent Int
4 GroupedInterfaceContent
content)
          [GroupedInterfaceContent]
properties
      )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}"
buildDeclarationType (ImportDec FilePath
symbolName FilePath
path) =
  Builder
"import " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
symbolName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" from './" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
path Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"';"

data GroupedInterfaceContent
  = -- | A group of interface contents (potentially with subgroups).
    GroupedInterfaceContent InterfaceContentGroup
  | -- | A single interface content.
    SingleInterfaceContent InterfaceContent

buildGroupedInterfaceContent :: Int -> GroupedInterfaceContent -> TLB.Builder
buildGroupedInterfaceContent :: Int -> GroupedInterfaceContent -> Builder
buildGroupedInterfaceContent Int
indentationAmount (SingleInterfaceContent InterfaceContent
content) =
  Int -> InterfaceContent -> Builder
buildInterfaceContent Int
indentationAmount InterfaceContent
content
buildGroupedInterfaceContent Int
indentationAmount (GroupedInterfaceContent InterfaceContentGroup
group) =
  let indentation :: Builder
indentation = Text -> Builder
TLB.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indentationAmount) Text
" "
      comment :: Builder
comment = Int -> [FilePath] -> Builder
buildMultilineComment Int
indentationAmount (InterfaceContentGroup -> [FilePath]
groupedInterfaceContentComment InterfaceContentGroup
group)
      groupHeader :: Builder
groupHeader = Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString (InterfaceContentGroup -> FilePath
groupedInterfaceContentName InterfaceContentGroup
group) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": {"
      groupContents :: Builder
groupContents =
        [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
          (GroupedInterfaceContent -> Builder)
-> [GroupedInterfaceContent] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map
            (\GroupedInterfaceContent
content -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> GroupedInterfaceContent -> Builder
buildGroupedInterfaceContent (Int
indentationAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) GroupedInterfaceContent
content)
            (InterfaceContentGroup -> [GroupedInterfaceContent]
groupedInterfaceContentValues InterfaceContentGroup
group)
      groupFooter :: Builder
groupFooter = Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"}\n"
   in Builder
comment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
groupHeader Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
groupContents Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
groupFooter

data InterfaceContentGroup = InterfaceContentGroup
  { InterfaceContentGroup -> [FilePath]
groupedInterfaceContentComment :: [String]
  -- ^ Comments for the grouped interface content.
  , InterfaceContentGroup -> FilePath
groupedInterfaceContentName :: String
  -- ^ The name of the group.
  , InterfaceContentGroup -> [GroupedInterfaceContent]
groupedInterfaceContentValues :: [GroupedInterfaceContent]
  -- ^ The list of grouped interface contents in the group.
  }

-- | Represents a function parameter in TypeScript.
data FunctionParam = FunctionParam
  { FunctionParam -> FilePath
paramName :: String
  -- ^ Name of the parameter.
  , FunctionParam -> FilePath
paramType :: String
  -- ^ Type of the parameter.
  }

-- | Creates a builder for a TypeScript function parameter.
buildFunctionParam :: FunctionParam -> TLB.Builder
buildFunctionParam :: FunctionParam -> Builder
buildFunctionParam (FunctionParam FilePath
name FilePath
pType) =
  FilePath -> Builder
TLB.fromString FilePath
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
pType

-- | Represents a TypeScript function header.
data FunctionHeader = FunctionHeader
  { FunctionHeader -> FilePath
functionName :: String
  -- ^ Name of the function.
  , FunctionHeader -> [FunctionParam]
functionParams :: [FunctionParam]
  -- ^ List of parameters of the function.
  , FunctionHeader -> FilePath
functionReturnType :: String
  -- ^ Return type of the function.
  }

-- | Creates a builder for a TypeScript function header.
buildFunctionHeader :: FunctionHeader -> TLB.Builder
buildFunctionHeader :: FunctionHeader -> Builder
buildFunctionHeader (FunctionHeader FilePath
name [FunctionParam]
params FilePath
returnType) =
  FilePath -> Builder
TLB.fromString FilePath
name
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"("
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
mconcatWith Builder
", " ((FunctionParam -> Builder) -> [FunctionParam] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map FunctionParam -> Builder
buildFunctionParam [FunctionParam]
params)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"): "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
returnType

-- | Represents a TypeScript interface content of some type
-- out of the ones defined by 'InterfaceContentType'.
data InterfaceContent = InterfaceContent
  { InterfaceContent -> [FilePath]
interfaceContentComment :: [String]
  -- ^ Comments for the interface content.
  , InterfaceContent -> InterfaceContentType
interfaceContentValue :: InterfaceContentType
  -- ^ The type and content of the interface.
  }

-- | Creates a builder for a TypeScript interface content.
buildInterfaceContent :: Int -> InterfaceContent -> TLB.Builder
buildInterfaceContent :: Int -> InterfaceContent -> Builder
buildInterfaceContent Int
_indentationAmount (InterfaceContent [] InterfaceContentType
interfaceType) = InterfaceContentType -> Builder
buildInterfaceContentType InterfaceContentType
interfaceType
buildInterfaceContent Int
indentationAmount (InterfaceContent [FilePath]
comments InterfaceContentType
interfaceType) =
  let indentation :: Builder
indentation = Text -> Builder
TLB.fromLazyText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indentationAmount) Text
" "
      comment :: Builder
comment = Int -> [FilePath] -> Builder
buildMultilineComment Int
indentationAmount [FilePath]
comments
   in Builder
comment Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
indentation Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> InterfaceContentType -> Builder
buildInterfaceContentType InterfaceContentType
interfaceType Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

-- | Represents a TypeScript interface type and content.
data InterfaceContentType
  = -- | Defines a property in the interface.
    InterfaceProperty
      String
      -- ^ Property name.
      String
      -- ^ Property type.
  | -- | Defines a method in the interface.
    InterfaceMethod
      String
      -- ^ Method name.
      [FunctionParam]
      -- ^ Method parameters.
      String
      -- ^ Return type of the method.

-- | Creates a builder for a TypeScript interface content and type.
buildInterfaceContentType :: InterfaceContentType -> TLB.Builder
buildInterfaceContentType :: InterfaceContentType -> Builder
buildInterfaceContentType (InterfaceProperty FilePath
name FilePath
pType) =
  FilePath -> Builder
TLB.fromString FilePath
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
pType Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"
buildInterfaceContentType (InterfaceMethod FilePath
name [FunctionParam]
params FilePath
returnType) =
  FilePath -> Builder
TLB.fromString FilePath
name
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"("
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
mconcatWith Builder
", " ((FunctionParam -> Builder) -> [FunctionParam] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map FunctionParam -> Builder
buildFunctionParam [FunctionParam]
params)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"): "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
TLB.fromString FilePath
returnType
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

-- | Concatenates a list of builders with a separator.
-- If the list is empty, it returns an empty builder.
mconcatWith :: TLB.Builder -> [TLB.Builder] -> TLB.Builder
mconcatWith :: Builder -> [Builder] -> Builder
mconcatWith Builder
separator = Builder
-> (NonEmpty Builder -> Builder)
-> Maybe (NonEmpty Builder)
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty ((Builder -> Builder -> Builder) -> NonEmpty Builder -> Builder
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Builder
a Builder
b -> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
separator Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)) (Maybe (NonEmpty Builder) -> Builder)
-> ([Builder] -> Maybe (NonEmpty Builder)) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Maybe (NonEmpty Builder)
forall a. [a] -> Maybe (NonEmpty a)
LNE.nonEmpty