content: {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module API.Docs.Generate.TypeScript where
  
  import API.Docs.Commands
  import API.Docs.Events
  import API.Docs.Generate
  import API.Docs.Responses
  import API.Docs.Syntax
  import API.Docs.Syntax.Types
  import API.Docs.Types
  import API.TypeInfo
  import Data.Char (toUpper)
  import qualified Data.List.NonEmpty as L
  import Data.Text (Text)
  import qualified Data.Text as T
  
  commandsCodeFile :: FilePath
  commandsCodeFile = "./packages/simplex-chat-client/types/typescript/src/commands.ts"
  
  responsesCodeFile :: FilePath
  responsesCodeFile = "./packages/simplex-chat-client/types/typescript/src/responses.ts"
  
  eventsCodeFile :: FilePath
  eventsCodeFile = "./packages/simplex-chat-client/types/typescript/src/events.ts"
  
  typesCodeFile :: FilePath
  typesCodeFile = "./packages/simplex-chat-client/types/typescript/src/types.ts"
  
  commandsCodeText :: Text
  commandsCodeText =
    ("// API Commands\n// " <> autoGenerated <> "\n")
      <> "\nimport * as T from \"./types\"\n"
      <> "\nimport {CR} from \"./responses\"\n"
      <> foldMap commandCatCode chatCommandsDocs
    where
      commandCatCode CCCategory {categoryName, categoryDescr, commands} =
        (T.pack $ "\n// " <> categoryName <> "\n// " <> categoryDescr <> "\n")
          <> foldMap commandCode commands
        where
          commandCode CCDoc {commandType = ATUnionMember tag params, commandDescr, syntax, responses, network} =
            ("\n// " <> commandDescr <> "\n")
              <> ("// Network usage: " <> networkUsage network <> ".\n")
              <> ("export interface " <> T.pack constrName <> " {\n")
              <> fieldsCode "" "T." params
              <> "}\n\n"
              <> ("export namespace " <> T.pack constrName <> " {\n")
              <> ("  export type Response = " <> constrsCode "  " "CR" (("CR." <> ) . T.pack . fstToUpper . memberTag) (map responseType responses))
              <> (if syntax == "" then "" else funcCode APITypeDef {typeName' = constrName, typeDef = ATDRecord params} syntax)
              <> "}\n"
            where
              constrName = fstToUpper tag
  
  responsesCodeText :: Text
  responsesCodeText =
    ("// API Responses\n// " <> autoGenerated <> "\n")
      <> "\nimport * as T from \"./types\"\n"
      <> unionTypeCode "CR" "T." chatRespTypeDef chatRespConstrs ""
    where
      chatRespTypeDef = APITypeDef {typeName' = "ChatResponse", typeDef = ATDUnion chatRespConstrs}
      chatRespConstrs = L.fromList $ map responseType chatResponsesDocs
  
  eventsCodeText :: Text
  eventsCodeText =
    ("// API Events\n// " <> autoGenerated <> "\n")
      <> "\nimport * as T from \"./types\"\n"
      <> unionTypeCode "CEvt" "T." chatEventTypeDef chatEventConstrs ""
    where
      chatEventTypeDef = APITypeDef {typeName' = "ChatEvent", typeDef = ATDUnion chatEventConstrs}
      chatEventConstrs = L.fromList $ concatMap catEvents chatEventsDocs
      catEvents CECategory {mainEvents, otherEvents} = map eventType $ mainEvents ++ otherEvents
  
  typesCodeText :: Text
  typesCodeText = ("// API Types\n// " <> autoGenerated <> "\n") <> foldMap typeCode chatTypesDocs
    where
      typeCode CTDoc {typeDef = td@APITypeDef {typeName' = name, typeDef}, typeDescr, typeSyntax} =
        (if T.null typeDescr then "" else "// " <> typeDescr <> "\n")
          <> typeDefCode
          -- <> (if typeSyntax == "" then "" else syntaxText (name, self : typeFields) typeSyntax)
        where
          name' = T.pack name
          constrName tag = case name of
            "ConnectionMode" -> T.pack $ map toUpper tag
            "FileProtocol" -> T.pack $ map toUpper tag
            _ -> T.replace "-" "_" $ T.pack $ fstToUpper tag
          namespaceFuncCode = "\nexport namespace " <> name' <> " {" <> funcCode td typeSyntax <> "}\n"
          typeDefCode = case typeDef of
            ATDRecord fields ->
              ("\nexport interface " <> name' <> " {\n")
                <> fieldsCode "" "" fields
                <> "}\n"
                <> (if typeSyntax == "" then "" else namespaceFuncCode)
            ATDEnum cs ->
              ("\nexport enum " <> name' <> " {\n")
                <> foldMap (\m -> "  " <> constrName m <> " = \"" <> T.pack m <> "\",\n") cs
                <> "}\n"
                <> (if typeSyntax == "" then "" else namespaceFuncCode)
            ATDUnion cs -> unionTypeCode name' "" td cs typeSyntax
  
  unionTypeCode :: Text -> String -> APITypeDef -> L.NonEmpty ATUnionMember -> Expr -> Text
  unionTypeCode unionNamespace typesNamespace td@APITypeDef {typeName' = name} cs cmdSyntax =
    ("\nexport type " <> name' <> " = " <> constrsCode "" name' constrTypeRef (L.toList cs) <> "\n")
      <> ("export namespace " <> unionNamespace <> " {\n")
      <> ("  export type Tag = " <> constrsCode "  " name' constrTag (L.toList cs) <> "\n")
      <> ("  interface Interface {\n    type: Tag\n  }\n")
      <> foldMap constrType cs
      <> (if cmdSyntax == "" then "" else funcCode td cmdSyntax)
      <> "}\n"
    where
      name' = T.pack name
      constrTypeRef (ATUnionMember tag _) = unionNamespace <> "." <> constrName tag
      constrTag (ATUnionMember tag _) = T.pack $ "\"" <> tag <> "\""
      constrType c@(ATUnionMember tag fields) =
        ("\n  export interface " <> constrName tag <> " extends Interface {\n")
          <> "    type: " <> constrTag c <> "\n"
          <> fieldsCode "  " typesNamespace fields
          <> "  }\n"
      constrName tag = T.replace "-" "_" (T.pack $ fstToUpper tag)
  
  constrsCode :: Text -> Text -> (ATUnionMember -> Text) -> [ATUnionMember] -> Text
  constrsCode indent name' constr cs
    | T.length (name' <> " = " <> line) <= 100 = line <> "\n"
    | otherwise = "\n" <> foldMap (\c -> indent <> "  | " <> c <> "\n") cs'
    where
      line = T.intercalate " | " cs'
      cs' = map constr cs
  
  funcCode :: APITypeDef -> Expr -> Text
  funcCode td@APITypeDef {typeName' = name, typeDef} cmdSyntax =
    "\n  export function cmdString(" <> param <> ": " <> T.pack name <> "): string {\n    return " <> jsSyntaxText True (name, self : typeFields) cmdSyntax <> "\n  }\n"
    where
      param = if hasParams cmdSyntax then "self" else "_self"
      self = APIRecordField "self" (ATDef td)
      typeFields = case typeDef of
        ATDRecord fs -> fs
        ATDUnion ms -> APIRecordField "type" tagType : concatMap (\(ATUnionMember _ fs) -> fs) ms
          where
            tagType = ATDef $ APITypeDef (name <> ".type") $ ATDEnum tags
            tags = L.map (\(ATUnionMember tag _) -> tag) ms
        ATDEnum _ -> []
  
  fieldsCode :: Text -> String -> [APIRecordField] -> Text
  fieldsCode indent namespace = foldMap $ (indent <>) . T.pack . fieldText
    where
      fieldText (APIRecordField name t) = "  " <> name <> optional t <> ": " <> typeText t <> typeComment t <> "\n"
      optional = \case
        ATOptional _ -> "?"
        _ -> ""
      typeText = \case
        ATPrim (PT t) -> typeName t
        ATDef (APITypeDef t _) -> namespace <> t
        ATRef t -> namespace <> t
        ATOptional t -> typeText t
        ATArray {elemType} -> typeText elemType <> "[]"
        ATMap (PT t) valueType -> "{[key: " <> typeName t <> "]: " <> typeText valueType <> "}"
      typeName = \case
        TBool -> "boolean"
        TInt -> "number"
        TInt64 -> "number"
        TWord32 -> "number"
        TDouble -> "number"
        TJSONObject -> "object"
        TUTCTime -> "string"
        t -> t
      typeComment t = let c = typeComment' t in if null c then "" else " // " <> c
      typeComment' = \case
        ATPrim (PT t) -> typeComment_ t
        ATOptional (ATPrim (PT t)) -> typeComment_ t
        ATArray {elemType, nonEmpty}
          | nonEmpty -> (if null c then "" else c <> ", ") <> "non-empty"
          | otherwise -> c
          where
            c = typeComment' elemType
        ATMap (PT k) v ->
          let kc = typeComment_ k
              vc = typeComment' v
              tc t c = if null c then t else c
           in if null kc && null vc then "" else tc (typeName k) kc <> " : " <> tc (typeText v) vc
        _ -> ""
      typeComment_ = \case
        TInt -> "int"
        TInt64 -> "int64"
        TWord32 -> "word32"
        TDouble -> "double"
        TUTCTime -> "ISO-8601 timestamp"
        _ -> ""
  