{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Source.Language
  ( Language (..)
  , SLanguage (..)
  , extensionsForLanguage
  , knownLanguage
  , forPath
  , textToLanguage
  , languageToText
  ) where

import           Data.Aeson
import           Data.Hashable (Hashable)
import qualified Data.Languages as Lingo
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import           GHC.Generics (Generic)
import qualified System.Path as Path
import qualified System.Path.PartClass as Path.PartClass

-- | The various languages we support.
data Language
    = Unknown
    | Go
    | Haskell
    | Java
    | JavaScript
    | JSON
    | JSX
    | Markdown
    | PHP
    | Python
    | Ruby
    | TypeScript
    | TSX
    | CodeQL
    deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic, Eq Language
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
Ord, ReadPrec [Language]
ReadPrec Language
Int -> ReadS Language
ReadS [Language]
(Int -> ReadS Language)
-> ReadS [Language]
-> ReadPrec Language
-> ReadPrec [Language]
-> Read Language
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Language]
$creadListPrec :: ReadPrec [Language]
readPrec :: ReadPrec Language
$creadPrec :: ReadPrec Language
readList :: ReadS [Language]
$creadList :: ReadS [Language]
readsPrec :: Int -> ReadS Language
$creadsPrec :: Int -> ReadS Language
Read, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
maxBound :: Language
$cmaxBound :: Language
minBound :: Language
$cminBound :: Language
Bounded, Int -> Language -> Int
Language -> Int
(Int -> Language -> Int) -> (Language -> Int) -> Hashable Language
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Language -> Int
$chash :: Language -> Int
hashWithSalt :: Int -> Language -> Int
$chashWithSalt :: Int -> Language -> Int
Hashable, [Language] -> Encoding
[Language] -> Value
Language -> Encoding
Language -> Value
(Language -> Value)
-> (Language -> Encoding)
-> ([Language] -> Value)
-> ([Language] -> Encoding)
-> ToJSON Language
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Language] -> Encoding
$ctoEncodingList :: [Language] -> Encoding
toJSONList :: [Language] -> Value
$ctoJSONList :: [Language] -> Value
toEncoding :: Language -> Encoding
$ctoEncoding :: Language -> Encoding
toJSON :: Language -> Value
$ctoJSON :: Language -> Value
ToJSON, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Language -> Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFrom :: Language -> [Language]
fromEnum :: Language -> Int
$cfromEnum :: Language -> Int
toEnum :: Int -> Language
$ctoEnum :: Int -> Language
pred :: Language -> Language
$cpred :: Language -> Language
succ :: Language -> Language
$csucc :: Language -> Language
Enum)

-- | Reifies a proxied type-level 'Language' to a value.
class SLanguage (lang :: Language) where
  reflect :: proxy lang -> Language

instance SLanguage 'Unknown where
  reflect :: forall (proxy :: Language -> *). proxy 'Unknown -> Language
reflect proxy 'Unknown
_ = Language
Unknown

instance SLanguage 'CodeQL where
  reflect :: forall (proxy :: Language -> *). proxy 'CodeQL -> Language
reflect proxy 'CodeQL
_ = Language
CodeQL

instance SLanguage 'Go where
  reflect :: forall (proxy :: Language -> *). proxy 'Go -> Language
reflect proxy 'Go
_ = Language
Go

instance SLanguage 'Haskell where
  reflect :: forall (proxy :: Language -> *). proxy 'Haskell -> Language
reflect proxy 'Haskell
_ = Language
Haskell

instance SLanguage 'Java where
  reflect :: forall (proxy :: Language -> *). proxy 'Java -> Language
reflect proxy 'Java
_ = Language
Java

instance SLanguage 'JavaScript where
  reflect :: forall (proxy :: Language -> *). proxy 'JavaScript -> Language
reflect proxy 'JavaScript
_ = Language
JavaScript

instance SLanguage 'JSON where
  reflect :: forall (proxy :: Language -> *). proxy 'JSON -> Language
reflect proxy 'JSON
_ = Language
JSON

instance SLanguage 'JSX where
  reflect :: forall (proxy :: Language -> *). proxy 'JSX -> Language
reflect proxy 'JSX
_ = Language
JSX

instance SLanguage 'Markdown where
  reflect :: forall (proxy :: Language -> *). proxy 'Markdown -> Language
reflect proxy 'Markdown
_ = Language
Markdown

instance SLanguage 'PHP where
  reflect :: forall (proxy :: Language -> *). proxy 'PHP -> Language
reflect proxy 'PHP
_ = Language
PHP

instance SLanguage 'Python where
  reflect :: forall (proxy :: Language -> *). proxy 'Python -> Language
reflect proxy 'Python
_ = Language
Python

instance SLanguage 'Ruby where
  reflect :: forall (proxy :: Language -> *). proxy 'Ruby -> Language
reflect proxy 'Ruby
_ = Language
Ruby

instance SLanguage 'TypeScript where
  reflect :: forall (proxy :: Language -> *). proxy 'TypeScript -> Language
reflect proxy 'TypeScript
_ = Language
TypeScript

instance FromJSON Language where
  parseJSON :: Value -> Parser Language
parseJSON = String -> (Text -> Parser Language) -> Value -> Parser Language
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Language" ((Text -> Parser Language) -> Value -> Parser Language)
-> (Text -> Parser Language) -> Value -> Parser Language
forall a b. (a -> b) -> a -> b
$ \Text
l ->
    Language -> Parser Language
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Language -> Parser Language) -> Language -> Parser Language
forall a b. (a -> b) -> a -> b
$ Text -> Language
textToLanguage Text
l


-- | Predicate failing on 'Unknown' and passing in all other cases.
knownLanguage :: Language -> Bool
knownLanguage :: Language -> Bool
knownLanguage = (Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
/= Language
Unknown)

extensionsForLanguage :: Language -> [String]
extensionsForLanguage :: Language -> [String]
extensionsForLanguage Language
language = (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack ([Text] -> (Language -> [Text]) -> Maybe Language -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
forall a. Monoid a => a
mempty Language -> [Text]
Lingo.languageExtensions (Text -> Map Text Language -> Maybe Language
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Language -> Text
languageToText Language
language) Map Text Language
Lingo.languages))

forPath :: Path.PartClass.AbsRel ar => Path.File ar -> Language
forPath :: forall ar. AbsRel ar => File ar -> Language
forPath File ar
path =
  let spurious :: a -> Bool
spurious a
lang = a
lang a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ a
"Hack" -- .php files
                                  , a
"GCC Machine Description" -- .md files
                                  , a
"XML" -- .tsx files
                                  ]
      allResults :: [Text]
allResults = Language -> Text
Lingo.languageName (Language -> Text) -> [Language] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [Language]
Lingo.languagesForPath (File ar -> String
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> String
Path.toString File ar
path)
  in case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
spurious) [Text]
allResults of
    [Text
result] -> Text -> Language
textToLanguage Text
result
    [Text]
_        -> Language
Unknown

languageToText :: Language -> T.Text
languageToText :: Language -> Text
languageToText = \case
  Language
Unknown -> Text
"Unknown"
  Language
CodeQL -> Text
"CodeQL"
  Language
Go -> Text
"Go"
  Language
Haskell -> Text
"Haskell"
  Language
Java -> Text
"Java"
  Language
JavaScript -> Text
"JavaScript"
  Language
JSON -> Text
"JSON"
  Language
JSX -> Text
"JSX"
  Language
Markdown -> Text
"Markdown"
  Language
PHP -> Text
"PHP"
  Language
Python -> Text
"Python"
  Language
Ruby -> Text
"Ruby"
  Language
TypeScript -> Text
"TypeScript"
  Language
TSX -> Text
"TSX"

textToLanguage :: T.Text -> Language
textToLanguage :: Text -> Language
textToLanguage = \case
  Text
"CodeQL" -> Language
CodeQL
  Text
"Go" -> Language
Go
  Text
"Haskell" -> Language
Haskell
  Text
"Java" -> Language
Java
  Text
"JavaScript" -> Language
JavaScript
  Text
"JSON" -> Language
JSON
  Text
"JSX" -> Language
JSX
  Text
"Markdown" -> Language
Markdown
  Text
"PHP" -> Language
PHP
  Text
"Python" -> Language
Python
  Text
"Ruby" -> Language
Ruby
  Text
"TypeScript" -> Language
TypeScript
  Text
"TSX" -> Language
TSX
  Text
_ -> Language
Unknown