1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
{-# LANGUAGE DerivingStrategies #-}
module Comment.Language
( Language (..),
fromPath,
parser,
lineStart,
block,
nodeTypes,
)
where
import Control.Exception (throw)
import Data.Binary (Binary)
import Data.Languages qualified as L
import Data.List.NonEmpty qualified as N
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Exception qualified as E
import Foreign.Ptr (Ptr)
import GHC.Generics (Generic)
import TreeSitter qualified as S
newtype Language = Language {languageKey :: L.LanguageKey}
deriving (Eq, Show, Generic)
deriving newtype (Binary)
-- TODO Support amiguous file languages
--
-- @backlog
fromPath :: FilePath -> Language
fromPath fp =
N.head
. fromMaybe (throw $ E.UnknownFile fp)
. N.nonEmpty
. map (Language . L.languageName)
$ L.languagesForPath fp
-- TODO Add support for all tree-sitter supported languages
--
-- @backlog
parser :: Language -> Ptr S.Language
parser (Language "C") = S.tree_sitter_c
parser (Language "Elm") = S.tree_sitter_elm
parser (Language "Haskell") = S.tree_sitter_haskell
parser (Language "Nix") = S.tree_sitter_nix
parser (Language "Shell") = S.tree_sitter_bash
parser (Language {languageKey}) = throw (E.UnsupportedLanguage languageKey)
lineStart :: Language -> T.Text
lineStart (Language "C") = "//"
lineStart (Language "Elm") = "--"
lineStart (Language "Haskell") = "--"
lineStart (Language "Nix") = "#"
lineStart (Language "Shell") = "#"
lineStart (Language {languageKey}) = throw (E.UnsupportedLanguage languageKey)
block :: Language -> Maybe ([T.Text], T.Text)
block (Language "C") = Just (["/*"], "*/")
block (Language "Elm") = Just (["{-|", "{-"], "-}")
block (Language "Haskell") = Just (["{-"], "-}")
block (Language "Nix") = Just (["/*"], "*/")
block (Language "Shell") = Nothing
block (Language {languageKey}) = throw (E.UnsupportedLanguage languageKey)
nodeTypes :: Language -> [String]
nodeTypes (Language "Haskell") = ["comment"]
nodeTypes (Language "Shell") = ["comment"]
nodeTypes (Language {languageKey}) = throw (E.UnsupportedLanguage languageKey)
|
