From 147604e59db7136b852e61bc6ac7f07b53987226 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 16 Aug 2019 14:06:49 -0700 Subject: [PATCH] Streamline manually language parsing --- src/Data/Language.hs | 83 ++++++++++++++++++-------------------- src/Semantic/Api/Bridge.hs | 33 +-------------- src/Semantic/CLI.hs | 18 ++++++++- 3 files changed, 56 insertions(+), 78 deletions(-) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 209b08f25..b1a5892a1 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -1,14 +1,15 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase #-} module Data.Language ( Language (..) , SLanguage (..) , extensionsForLanguage - , parseLanguage , knownLanguage , languageForFilePath , pathIsMinified , supportedExts , codeNavLanguages + , textToLanguage + , languageToText ) where import Data.Aeson @@ -78,63 +79,25 @@ instance SLanguage 'PHP where instance FromJSON Language where parseJSON = withText "Language" $ \l -> - pure $ fromMaybe Unknown (parseLanguage l) - -parseLanguage :: Text -> Maybe Language -parseLanguage l = case T.toLower l of - "go" -> Just Go - "haskell" -> Just Haskell - "java" -> Just Java - "javascript" -> Just JavaScript - "json" -> Just JSON - "jsx" -> Just JSX - "markdown" -> Just Markdown - "python" -> Just Python - "ruby" -> Just Ruby - "typescript" -> Just TypeScript - "php" -> Just PHP - _ -> Nothing + pure $ textToLanguage l -- | Predicate failing on 'Unknown' and passing in all other cases. knownLanguage :: Language -> Bool knownLanguage = (/= Unknown) extensionsForLanguage :: Language -> [String] -extensionsForLanguage language = case language of - Go -> [".go"] - Haskell -> [".hs"] - JavaScript -> [".js", ".mjs"] - PHP -> [".php", ".phpt"] - Python -> [".py"] - Ruby -> [".rb"] - TypeScript -> [".ts"] - TSX -> [".tsx", ".d.tsx"] - JSX -> [".jsx"] - _ -> [] +extensionsForLanguage language = T.unpack <$> maybe mempty Lingo.languageExtensions (Map.lookup (languageToText language) Lingo.languages) -- | Return a language based on a FilePath's extension. languageForFilePath :: FilePath -> Language -languageForFilePath path = case Lingo.languageName <$> Lingo.languageForPath path of - Just "Go" -> Go - Just "Haskell" -> Haskell - Just "Java" -> Java - Just "JavaScript" -> JavaScript - Just "JSON" -> JSON - Just "JSX" -> JSX - Just "Markdown" -> Markdown - Just "PHP" -> PHP - Just "Python" -> Python - Just "Ruby" -> Ruby - Just "TSX" -> TSX - Just "TypeScript" -> TypeScript - _ -> Unknown +languageForFilePath path = maybe Unknown (textToLanguage . Lingo.languageName) (Lingo.languageForPath path) supportedExts :: [String] supportedExts = foldr append mempty supportedLanguages where append (Just l) b = fmap T.unpack (Lingo.languageExtensions l) <> b append Nothing b = b - supportedLanguages = fmap lookup ["Go", "Ruby", "Python", "JavaScript", "TypeScript", "PHP"] + supportedLanguages = fmap lookup (languageToText <$> codeNavLanguages) lookup k = Map.lookup k Lingo.languages codeNavLanguages :: [Language] @@ -142,3 +105,35 @@ codeNavLanguages = [Go, Ruby, Python, JavaScript, TypeScript, PHP] pathIsMinified :: FilePath -> Bool pathIsMinified = isExtensionOf ".min.js" + +languageToText :: Language -> T.Text +languageToText = \case + Unknown -> "Unknown" + Go -> "Go" + Haskell -> "Haskell" + Java -> "Java" + JavaScript -> "JavaScript" + JSON -> "JSON" + JSX -> "JSX" + Markdown -> "Markdown" + Python -> "Python" + Ruby -> "Ruby" + TypeScript -> "TypeScript" + TSX -> "TSX" + PHP -> "PHP" + +textToLanguage :: T.Text -> Language +textToLanguage = \case + "Go" -> Go + "Haskell" -> Haskell + "Java" -> Java + "JavaScript" -> JavaScript + "JSON" -> JSON + "JSX" -> JSX + "Markdown" -> Markdown + "Python" -> Python + "Ruby" -> Ruby + "TypeScript" -> TypeScript + "TSX" -> TSX + "PHP" -> PHP + _ -> Unknown diff --git a/src/Semantic/Api/Bridge.hs b/src/Semantic/Api/Bridge.hs index 82e82f592..05613e1fd 100644 --- a/src/Semantic/Api/Bridge.hs +++ b/src/Semantic/Api/Bridge.hs @@ -64,38 +64,7 @@ instance APIConvert Legacy.Span Data.Span where fromAPI Legacy.Span {..} = Data.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) instance APIBridge T.Text Data.Language where - bridging = iso apiLanguageToLanguage languageToApiLanguage where - languageToApiLanguage :: Data.Language -> T.Text - languageToApiLanguage = \case - Data.Unknown -> "Unknown" - Data.Go -> "Go" - Data.Haskell -> "Haskell" - Data.Java -> "Java" - Data.JavaScript -> "JavaScript" - Data.JSON -> "JSON" - Data.JSX -> "JSX" - Data.Markdown -> "Markdown" - Data.Python -> "Python" - Data.Ruby -> "Ruby" - Data.TypeScript -> "TypeScript" - Data.TSX -> "TSX" - Data.PHP -> "PHP" - - apiLanguageToLanguage :: T.Text -> Data.Language - apiLanguageToLanguage = \case - "Go" -> Data.Go - "Haskell" -> Data.Haskell - "Java" -> Data.Java - "JavaScript" -> Data.JavaScript - "JSON" -> Data.JSON - "JSX" -> Data.JSX - "Markdown" -> Data.Markdown - "Python" -> Data.Python - "Ruby" -> Data.Ruby - "TypeScript" -> Data.TypeScript - "TSX" -> Data.TSX - "PHP" -> Data.PHP - _ -> Data.Unknown + bridging = iso Data.textToLanguage Data.languageToText instance APIBridge API.Blob Data.Blob where bridging = iso apiBlobToBlob blobToApiBlob where diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 4e47f0da2..e627b5444 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -5,7 +5,7 @@ import Control.Exception as Exc (displayException) import Data.Blob import Data.Blob.IO import Data.Handle -import Data.Language (languageForFilePath, parseLanguage) +import qualified Data.Language as Language import Data.List (intercalate, uncons) import Data.List.Split (splitWhen) import Data.Project @@ -180,8 +180,22 @@ filePathReader = eitherReader parseFilePath parseFilePath arg = case splitWhen (== ':') arg of [a, b] | Just lang <- parseLanguage (T.pack b) -> Right (File a lang) | Just lang <- parseLanguage (T.pack a) -> Right (File b lang) - [path] -> Right (File path (languageForFilePath path)) + [path] -> Right (File path (Language.languageForFilePath path)) _ -> Left ("cannot parse `" <> arg <> "`\nexpecting FILE:LANGUAGE or just FILE") + parseLanguage :: Text -> Maybe Language.Language + parseLanguage l = case T.toLower l of + "go" -> Just Language.Go + "haskell" -> Just Language.Haskell + "java" -> Just Language.Java + "javascript" -> Just Language.JavaScript + "json" -> Just Language.JSON + "jsx" -> Just Language.JSX + "markdown" -> Just Language.Markdown + "python" -> Just Language.Python + "ruby" -> Just Language.Ruby + "typescript" -> Just Language.TypeScript + "php" -> Just Language.PHP + _ -> Nothing options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options)))