content: {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module API.Docs.Generate where
  
  import API.Docs.Commands
  import API.Docs.Events
  import API.Docs.Responses
  import API.Docs.Syntax
  import API.Docs.Syntax.Types
  import API.Docs.Types
  import API.TypeInfo
  import Data.Char (isSpace, isUpper, toLower, toUpper)
  import qualified Data.List.NonEmpty as L
  import Data.Text (Text)
  import qualified Data.Text as T
  
  commandsDocFile :: FilePath
  commandsDocFile = "./bots/api/COMMANDS.md"
  
  eventsDocFile :: FilePath
  eventsDocFile = "./bots/api/EVENTS.md"
  
  typesDocFile :: FilePath
  typesDocFile = "./bots/api/TYPES.md"
  
  commandsDocText :: Text
  commandsDocText =
    ("# API Commands and Responses\n\n" <> autoGenerated <> "\n")
      <> foldMap commandCatTOC chatCommandsDocs
      <> "\n---\n"
      <> foldMap commandCatText chatCommandsDocs
    where
      commandCatTOC CCCategory {categoryName, commands} =
        (T.pack $ "\n" <> withLink "" categoryName <> "\n")
          <> foldMap commandTOC commands
        where
          commandTOC CCDoc {commandType = ATUnionMember tag _} = T.pack $ "- " <> withLink "" (fstToUpper tag) <> "\n"
      commandCatText CCCategory {categoryName, categoryDescr, commands} =
        (T.pack $ "\n\n## " <> categoryName <> "\n\n" <> categoryDescr <> "\n")
          <> foldMap commandDocText commands
        where
          commandDocText CCDoc {commandType = ATUnionMember tag params, commandDescr, network, syntax, responses, errors} =
            ("\n\n### " <> T.pack (fstToUpper tag) <> "\n\n" <> commandDescr <> "\n\n*Network usage*: " <> networkUsage network <> ".\n")
              <> (if null params then "" else paramsText)
              <> (if syntax == "" then "" else syntaxText (tag, params) syntax)
              <> (if length responses > 1 then "\n**Responses**:\n" else "\n**Response**:\n")
              <> foldMap responseText responses
              <> (if null errors then "" else "\n**Errors**:\n")
              <> foldMap errorText errors
              <> "\n---\n"
            where
              paramsText = "\n**Parameters**:\n" <> fieldsText "./TYPES.md" params
          responseText CRDoc {responseType = ATUnionMember tag fields, responseDescr} =
            (T.pack $ "\n" <> fstToUpper tag <> ": " <> respDescr <> ".\n")
              <> ("- type: \"" <> T.pack tag <> "\"\n")
              <> fieldsText "./TYPES.md" fields
            where
              respDescr = if null responseDescr then camelToSpace tag else responseDescr
          errorText (TD err descr) =
            let descr' = if null descr then camelToSpace err else descr
             in T.pack $ "- " <> fstToUpper err <> ": " <> descr' <> ".\n"
  
  networkUsage :: Maybe UsesNetwork -> Text
  networkUsage = \case
    Nothing -> "no"
    Just UNInteractive -> "interactive"
    Just UNBackground -> "background"
  
  syntaxText :: TypeAndFields -> Expr -> Text
  syntaxText r syntax =
    "\n**Syntax**:\n"
      <> "\n```\n" <> docSyntaxText r syntax <> "\n```\n"
      <> (if isConst syntax then "" else "\n```javascript\n" <> jsSyntaxText False r syntax <> " // JavaScript\n```\n")
      <> (if isConst syntax then "" else "\n```python\n" <> pySyntaxText r syntax <> " # Python\n```\n")
  
  camelToSpace :: String -> String
  camelToSpace [] = []
  camelToSpace (x : xs) = toUpper x : go xs
    where
      go [] = []
      go (y : ys)
        | isUpper y = ' ' : toLower y : go ys
        | otherwise = y : go ys
  
  eventsDocText :: Text
  eventsDocText =
    ("# API Events\n\n" <> autoGenerated <> "\n")
      <> foldMap eventCatTOC chatEventsDocs
      <> "\n---\n"
      <> foldMap eventCatText chatEventsDocs
    where
      eventCatTOC CECategory {categoryName, mainEvents, otherEvents} =
        (T.pack $ "\n" <> withLink "" categoryName <> "\n")
          <> (if hasOthers then "- Main event" <> plural mainEvents <> "\n" else "")
          <> foldMap eventTOC mainEvents
          <> (if hasOthers then "- Other event" <> plural otherEvents <> "\n" <> foldMap eventTOC otherEvents else "")
        where
          eventTOC CEDoc {eventType = ATUnionMember tag _} = T.pack $ indent <> "- " <> withLink "" (fstToUpper tag) <> "\n"
          hasOthers = not $ null otherEvents
          indent = if hasOthers then "  " else ""
      eventCatText CECategory {categoryName, categoryDescr, mainEvents, otherEvents} =
        (T.pack $ "\n\n## " <> categoryName <> "\n\n" <> categoryDescr <> "\n")
          <> foldMap eventDocText (mainEvents ++ otherEvents)
        where
          eventDocText CEDoc {eventType = ATUnionMember tag fields, eventDescr} =
            (T.pack $ "\n\n### " <> fstToUpper tag <> "\n\n" <> evtDescr)
              <> "\n\n**Record type**:\n"
              <> ("- type: \"" <> T.pack tag <> "\"\n")
              <> fieldsText "./TYPES.md" fields
              <> "\n---\n"
            where
              evtDescr = if null eventDescr then camelToSpace tag <> "." else eventDescr
      plural evts = if length evts == 1 then "" else "s"
  
  typesDocText :: Text
  typesDocText =
    ("# API Types\n\n" <> autoGenerated <> "\n")
      <> (foldMap (\t -> T.pack $ "\n- " <> withLink "" (docTypeName t)) chatTypesDocs <> "\n")
      <> foldMap typeDocText chatTypesDocs
    where
      typeDocText CTDoc {typeDef = td@APITypeDef {typeName' = name, typeDef}, typeDescr, typeSyntax} =
        ("\n\n---\n\n## " <> T.pack name <> "\n")
          <> (if T.null typeDescr then "" else "\n" <> typeDescr <> "\n")
          <> typeDefText typeDef
          <> (if typeSyntax == "" then "" else syntaxText (name, self : typeFields) typeSyntax)
        where
          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 _ -> []
      typeDefText = \case
        ATDRecord fields -> "\n**Record type**:\n" <> fieldsText "" fields
        ATDEnum cs -> "\n**Enum type**:\n" <> foldMap (\m -> "- \"" <> T.pack m <> "\"\n") cs
        ATDUnion cs -> "\n**Discriminated union type**:\n" <> foldMap constrText cs
          where
            constrText (ATUnionMember tag fields) =
              ("\n" <> T.pack (fstToUpper tag) <> ":\n")
                <> ("- type: \"" <> T.pack tag <> "\"\n")
                <> fieldsText "" fields
  
  fieldsText :: FilePath -> [APIRecordField] -> Text
  fieldsText docPath = foldMap $ T.pack . fieldText
    where
      fieldText (APIRecordField name t) = "- " <> name <> ": " <> typeText t <> "\n"
      typeText = \case
        ATPrim (PT t) -> t
        ATDef (APITypeDef t _) -> withLink docPath t
        ATRef t -> withLink docPath t
        ATOptional t -> typeText t <> "?"
        ATArray {elemType} -> "[" <> typeText elemType <> "]"
        ATMap (PT t) valueType -> "{" <> t <> " : " <> typeText valueType <> "}"
  
  autoGenerated :: Text
  autoGenerated = "This file is generated automatically."
  
  withLink :: FilePath -> String -> String
  withLink docPath s = "[" <> s <> "](" <> docPath <> "#" <> headerAnchor s <> ")"
    where
      headerAnchor = map $ \c -> if isSpace c then '-' else toLower c
  