{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: keywords for doc gen and testing
--
-- Collect keywords for documentation generation and testing.
module Swarm.Doc.Keyword (
  EditorType (..),

  -- ** Formatted keyword lists
  keywordsCommands,
  keywordsDirections,
  operatorNames,
  builtinFunctionList,
) where

import Data.List (nub)
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Doc.Util
import Swarm.Language.Syntax.Direction
import Swarm.Util (quote)

-- | An enumeration of the editors supported by Swarm (currently,
--   Emacs, VS Code and Vim).
data EditorType = Emacs | VSCode | Vim
  deriving (EditorType -> EditorType -> Bool
(EditorType -> EditorType -> Bool)
-> (EditorType -> EditorType -> Bool) -> Eq EditorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditorType -> EditorType -> Bool
== :: EditorType -> EditorType -> Bool
$c/= :: EditorType -> EditorType -> Bool
/= :: EditorType -> EditorType -> Bool
Eq, Int -> EditorType -> ShowS
[EditorType] -> ShowS
EditorType -> String
(Int -> EditorType -> ShowS)
-> (EditorType -> String)
-> ([EditorType] -> ShowS)
-> Show EditorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditorType -> ShowS
showsPrec :: Int -> EditorType -> ShowS
$cshow :: EditorType -> String
show :: EditorType -> String
$cshowList :: [EditorType] -> ShowS
showList :: [EditorType] -> ShowS
Show, Int -> EditorType
EditorType -> Int
EditorType -> [EditorType]
EditorType -> EditorType
EditorType -> EditorType -> [EditorType]
EditorType -> EditorType -> EditorType -> [EditorType]
(EditorType -> EditorType)
-> (EditorType -> EditorType)
-> (Int -> EditorType)
-> (EditorType -> Int)
-> (EditorType -> [EditorType])
-> (EditorType -> EditorType -> [EditorType])
-> (EditorType -> EditorType -> [EditorType])
-> (EditorType -> EditorType -> EditorType -> [EditorType])
-> Enum EditorType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EditorType -> EditorType
succ :: EditorType -> EditorType
$cpred :: EditorType -> EditorType
pred :: EditorType -> EditorType
$ctoEnum :: Int -> EditorType
toEnum :: Int -> EditorType
$cfromEnum :: EditorType -> Int
fromEnum :: EditorType -> Int
$cenumFrom :: EditorType -> [EditorType]
enumFrom :: EditorType -> [EditorType]
$cenumFromThen :: EditorType -> EditorType -> [EditorType]
enumFromThen :: EditorType -> EditorType -> [EditorType]
$cenumFromTo :: EditorType -> EditorType -> [EditorType]
enumFromTo :: EditorType -> EditorType -> [EditorType]
$cenumFromThenTo :: EditorType -> EditorType -> EditorType -> [EditorType]
enumFromThenTo :: EditorType -> EditorType -> EditorType -> [EditorType]
Enum, EditorType
EditorType -> EditorType -> Bounded EditorType
forall a. a -> a -> Bounded a
$cminBound :: EditorType
minBound :: EditorType
$cmaxBound :: EditorType
maxBound :: EditorType
Bounded)

builtinFunctionList :: EditorType -> Text
builtinFunctionList :: EditorType -> Text
builtinFunctionList EditorType
e = EditorType -> [Text] -> Text
editorList EditorType
e ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Text
constSyntax [Const]
builtinFunctions

editorList :: EditorType -> [Text] -> Text
editorList :: EditorType -> [Text] -> Text
editorList = \case
  EditorType
Emacs -> [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
quote)
  EditorType
VSCode -> Text -> [Text] -> Text
T.intercalate Text
"|"
  EditorType
Vim -> Text -> [Text] -> Text
T.intercalate Text
" "

-- | Get formatted list of basic functions/commands.
keywordsCommands :: EditorType -> Text
keywordsCommands :: EditorType -> Text
keywordsCommands EditorType
e = EditorType -> [Text] -> Text
editorList EditorType
e ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Text
constSyntax [Const]
commands

-- | Get formatted list of directions.
keywordsDirections :: EditorType -> Text
keywordsDirections :: EditorType -> Text
keywordsDirections EditorType
e = EditorType -> [Text] -> Text
editorList EditorType
e ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Direction -> Text) -> [Direction] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Direction -> Text
directionSyntax [Direction]
allDirs

-- | A list of the names of all the operators in the language.
-- These are reflective of how the different editors treat operators,
-- keywords, symbols etc differently.
-- In order to get the list of operators supported by Swarm language
-- irrespective of an editor, @map constSyntax operators@ should suffice.
operatorNames :: EditorType -> Text
operatorNames :: EditorType -> Text
operatorNames EditorType
e = case EditorType
e of
  EditorType
Emacs -> EditorType -> [Text] -> Text
editorList EditorType
e ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Text
constSyntax [Const]
operators [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
extraOperators
  -- Vim needs a list of unique characters that can be matched over using a regex
  EditorType
Vim -> String -> Text
T.pack (String -> Text) -> ([Text] -> String) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Eq a => [a] -> [a]
nub ShowS -> ([Text] -> String) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Text
constSyntax [Const]
operators [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
extraOperators
  EditorType
VSCode -> EditorType -> [Text] -> Text
editorList EditorType
e ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
escape (Text -> Text) -> (Const -> Text) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Text
constSyntax) [Const]
operators [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
extraOperators
 where
  slashNotComment :: Char -> Text
slashNotComment = \case
    Char
'/' -> Text
"/(?![/|*])"
    Char
c -> Char -> Text
T.singleton Char
c

  special :: String
  special :: String
special = String
"*+$[]|^"

  -- Extra operators appearing in different places. Eg: Type signatures.
  extraOperators :: [Text]
  extraOperators :: [Text]
extraOperators = [Text
":"]

  escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
T.concatMap (\Char
c -> if Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
special then Text -> Char -> Text
T.snoc Text
"\\" Char
c else Char -> Text
slashNotComment Char
c)