1--
2-- Copyright (c) 2013-2019 Nicola Bonelli <nicola@pfq.io>
3--
4-- This program is free software; you can redistribute it and/or modify
5-- it under the terms of the GNU General Public License as published by
6-- the Free Software Foundation; either version 2 of the License, or
7-- (at your option) any later version.
8--
9-- This program is distributed in the hope that it will be useful,
10-- but WITHOUT ANY WARRANTY; without even the implied warranty of
11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12-- GNU General Public License for more details.
13--
14-- You should have received a copy of the GNU General Public License
15-- along with this program; if not, write to the Free Software
16-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
17--
18
19{-# LANGUAGE TupleSections #-}
20
21module CGrep.Lang ( Lang(..)
22                  , langMap
23                  , getFileLang
24                  , splitLangList
25                  , dumpLangMap
26                  , dumpLangRevMap) where
27
28import qualified Data.Map as Map
29import System.FilePath(takeExtension, takeFileName)
30import Control.Monad
31import Control.Applicative
32import Data.Maybe
33
34import Options
35import Util
36
37
38data Lang = Assembly | Awk  | C | CMake | Cabal | Chapel | Clojure | Coffee | Conf | Cpp  | Csharp | Css |
39            D | Dart | Elixir | Erlang | Fortran | Fsharp | Go | Haskell | Html | Idris | Java | Javascript | Kotlin |
40            Latex | Lua | Make | Nmap | OCaml | ObjectiveC | PHP | Perl | Python | Ruby | Scala | Shell | Swift | Tcl |
41            Text | VHDL | Verilog | Vim | Yaml
42                deriving (Read, Show, Eq, Ord, Bounded)
43
44
45data FileType = Name String | Ext String
46    deriving (Eq, Ord)
47
48
49instance Show FileType where
50    show (Name x) = x
51    show (Ext  e) = "*." ++ e
52
53
54type LangMapType    = Map.Map Lang [FileType]
55type LangRevMapType = Map.Map FileType Lang
56
57
58langMap :: LangMapType
59langMap = Map.fromList
60    [  (Assembly,  [Ext "s", Ext "S"])
61    ,  (Awk,       [Ext "awk", Ext "mawk", Ext "gawk"])
62    ,  (C,         [Ext "c", Ext "C", Ext "inc"])
63    ,  (CMake,     [Name "CMakeLists.txt", Ext "cmake"])
64    ,  (Cabal,     [Ext "cabal"])
65    ,  (Chapel,    [Ext "chpl"])
66    ,  (Clojure,   [Ext "clj", Ext "cljs", Ext "cljc", Ext "edn"])
67    ,  (Coffee,    [Ext "coffee"])
68    ,  (Conf,      [Ext "config", Ext "conf", Ext "cfg", Ext "doxy"])
69    ,  (Cpp,       [Ext "cpp", Ext "CPP", Ext "cxx", Ext "cc", Ext "cp", Ext "c++", Ext "tcc",
70                    Ext "h", Ext "H", Ext "hpp", Ext "ipp", Ext "HPP", Ext "hxx", Ext "hh", Ext "hp", Ext "h++",
71                    Ext "cu", Ext "cuh"])
72    ,  (Csharp,    [Ext "cs", Ext "CS"])
73    ,  (Css,       [Ext "css"])
74    ,  (D,         [Ext "d", Ext "D"])
75    ,  (Dart,      [Ext "dart"])
76    ,  (Elixir,    [Ext "ex", Ext "exs"])
77    ,  (Erlang,    [Ext "erl", Ext "ERL",Ext "hrl", Ext "HRL"])
78    ,  (Fortran,   [Ext "f", Ext "for", Ext "ftn",
79                    Ext "F", Ext "FOR", Ext "FTN", Ext "fpp", Ext "FPP",
80                    Ext "f90", Ext "f95", Ext "f03", Ext "f08",
81                    Ext "F90", Ext "F95", Ext "F03", Ext "F08"])
82    ,  (Fsharp,    [Ext "fs", Ext "fsx", Ext "fsi"])
83    ,  (Go,        [Ext "go"])
84    ,  (Haskell,   [Ext "hs", Ext "lhs", Ext "hsc"])
85    ,  (Html,      [Ext "htm", Ext "html"])
86    ,  (Idris,     [Ext "idr", Ext "lidr"])
87    ,  (Java,      [Ext "java"])
88    ,  (Javascript,[Ext "js"])
89    ,  (Kotlin,    [Ext "kt", Ext "kts", Ext "ktm"])
90    ,  (Latex,     [Ext "latex", Ext "tex"])
91    ,  (Lua,       [Ext "lua"])
92    ,  (Make,      [Name "Makefile", Name "makefile", Name "GNUmakefile", Ext "mk", Ext  "mak"])
93    ,  (Nmap,      [Ext "nse"])
94    ,  (OCaml ,    [Ext "ml", Ext "mli"])
95    ,  (ObjectiveC,[Ext "m", Ext "mi"])
96    ,  (PHP,       [Ext "php", Ext "php3", Ext "php4", Ext "php5",Ext "phtml"])
97    ,  (Perl,      [Ext "pl", Ext "pm", Ext "pm6", Ext "plx", Ext "perl"])
98    ,  (Python,    [Ext "py", Ext "pyx", Ext "pxd", Ext "pxi", Ext "scons"])
99    ,  (Ruby,      [Ext "rb", Ext "ruby"])
100    ,  (Scala,     [Ext "scala"])
101    ,  (Shell,     [Ext "sh", Ext "bash", Ext "csh", Ext "tcsh", Ext "ksh", Ext "zsh"])
102    ,  (Swift,     [Ext "swift"])
103    ,  (Tcl,       [Ext "tcl", Ext "tk"])
104    ,  (Text,      [Ext "txt", Ext "md", Ext "markdown", Ext "mdown", Ext "mkdn", Ext "mkd", Ext "mdwn", Ext "mdtxt", Ext "mdtext", Ext "text", Name "README", Name "INSTALL", Name "VERSION", Name "LICENSE", Name "AUTHORS", Name "CHANGELOG"])
105    ,  (VHDL,      [Ext "vhd", Ext "vhdl"])
106    ,  (Verilog,   [Ext "v", Ext "vh", Ext "sv"])
107    ,  (Vim,       [Ext "vim"])
108    ,  (Yaml,      [Ext "yaml", Ext "yml"])
109    ]
110
111
112langRevMap :: LangRevMapType
113langRevMap = Map.fromList $ concatMap (\(l, xs) -> map (,l) xs ) $ Map.toList langMap
114
115-- utility functions
116
117lookupFileLang :: FilePath -> Maybe Lang
118lookupFileLang f = Map.lookup (Name $ takeFileName f) langRevMap <|> Map.lookup (Ext (let name = takeExtension f in case name of ('.':xs) -> xs; _ -> name )) langRevMap
119
120
121forcedLang :: Options -> Maybe Lang
122forcedLang Options{ language_force = l }
123    | Nothing <- l = Nothing
124    | otherwise    = Map.lookup (Ext $ fromJust l) langRevMap <|> Map.lookup (Name $ fromJust l) langRevMap
125
126
127getFileLang :: Options -> FilePath -> Maybe Lang
128getFileLang opts f = forcedLang opts <|> lookupFileLang f
129
130
131dumpLangMap :: LangMapType -> IO ()
132dumpLangMap m = forM_ (Map.toList m) $ \(l, ex) ->
133                putStrLn $ show l ++ [ ' ' | _ <- [length (show l)..12]] ++ "-> " ++ show ex
134
135
136dumpLangRevMap :: LangRevMapType -> IO ()
137dumpLangRevMap m = forM_ (Map.toList m) $ \(ext, l) ->
138                    putStrLn $ show ext ++ [ ' ' | _ <- [length (show ext)..12 ]] ++ "-> " ++ show l
139
140
141splitLangList :: [String] -> ([Lang], [Lang], [Lang])
142splitLangList  = foldl run ([],[],[])
143    where run :: ([Lang], [Lang], [Lang]) -> String -> ([Lang], [Lang], [Lang])
144          run (l1, l2, l3) l
145            | '+':xs <- l = (l1, prettyRead xs "Lang" : l2, l3)
146            | '-':xs <- l = (l1, l2, prettyRead xs "Lang" : l3)
147            | otherwise   = (prettyRead l  "Lang" : l1, l2, l3)
148