From 2510df0e23dc9433495c7c5800821eb7a9f27c36 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 30 Jul 2019 12:26:51 -0700 Subject: [PATCH 1/5] Switch over to using lingo --- cabal.project | 5 +++++ semantic.cabal | 1 + src/Data/Blob/IO.hs | 2 +- src/Data/Language.hs | 38 ++++++++++++++++---------------------- 4 files changed, 23 insertions(+), 23 deletions(-) diff --git a/cabal.project b/cabal.project index 2a7af0f0f2..75a29b096f 100644 --- a/cabal.project +++ b/cabal.project @@ -14,3 +14,8 @@ source-repository-package type: git location: https://github.com/joshvera/proto3-wire.git tag: 84664e22f01beb67870368f1f88ada5d0ad01f56 + +source-repository-package + type: git + location: https://github.com/tclem/lingo-haskell.git + tag: 7a453568556d7b6ab6fb4573b158b41cef56f7cc diff --git a/semantic.cabal b/semantic.cabal index d0cb1fce5a..8c4092debc 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -73,6 +73,7 @@ common dependencies , unix ^>= 2.7.2.2 , proto3-suite , proto3-wire + , lingo common executable-flags ghc-options: -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m" diff --git a/src/Data/Blob/IO.hs b/src/Data/Blob/IO.hs index 75b041b597..175729849a 100644 --- a/src/Data/Blob/IO.hs +++ b/src/Data/Blob/IO.hs @@ -38,7 +38,7 @@ readBlobsFromDir :: MonadIO m => FilePath -> m [Blob] readBlobsFromDir path = liftIO . fmap catMaybes $ findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForPath) --- | Read all blobs from the Git repo with Language.supportedExts +-- | Read all blobs from a git repo readBlobsFromGitRepo :: MonadIO m => FilePath -> Git.OID -> [FilePath] -> [FilePath] -> m [Blob] readBlobsFromGitRepo path oid excludePaths includePaths = liftIO . fmap catMaybes $ Git.lsTree path oid >>= Async.mapConcurrently (blobFromTreeEntry path) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 952521145a..d21ee20c88 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -7,12 +7,12 @@ module Data.Language , knownLanguage , languageForFilePath , pathIsMinified - , languageForType , supportedExts , codeNavLanguages ) where import Data.Aeson +import qualified Data.Languages as Lingo import qualified Data.Text as T import Prologue import System.FilePath.Posix @@ -98,25 +98,6 @@ parseLanguage l = case T.toLower l of knownLanguage :: Language -> Bool knownLanguage = (/= Unknown) --- | Returns a Language based on the file extension (including the "."). -languageForType :: String -> Language -languageForType mediaType = case mediaType of - ".java" -> Java - ".json" -> JSON - ".hs" -> Haskell - ".md" -> Markdown - ".rb" -> Ruby - ".go" -> Go - ".js" -> JavaScript - ".mjs" -> JavaScript - ".ts" -> TypeScript - ".tsx" -> TSX - ".jsx" -> JSX - ".py" -> Python - ".php" -> PHP - ".phpt" -> PHP - _ -> Unknown - extensionsForLanguage :: Language -> [String] extensionsForLanguage language = case language of Go -> [".go"] @@ -130,9 +111,22 @@ extensionsForLanguage language = case language of JSX -> [".jsx"] _ -> [] --- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported. +-- | Return a language based on a FilePath's extension. languageForFilePath :: FilePath -> Language -languageForFilePath = languageForType . takeExtension +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 supportedExts :: [String] supportedExts = [".go", ".py", ".rb", ".js", ".mjs", ".ts", ".php", ".phpt"] From 0aab5ebd55804f5fbe41ab8f892c33eb439ad85d Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 15 Aug 2019 15:48:17 -0700 Subject: [PATCH 2/5] Replace supportedExts --- semantic.cabal | 1 + src/Data/Language.hs | 8 +++++++- test/Data/Language/Spec.hs | 12 ++++++++++++ test/Spec.hs | 2 ++ 4 files changed, 22 insertions(+), 1 deletion(-) create mode 100644 test/Data/Language/Spec.hs diff --git a/semantic.cabal b/semantic.cabal index 8c4092debc..a4a2ab8491 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -361,6 +361,7 @@ test-suite test , Data.Functor.Listable , Data.Graph.Spec , Data.Mergeable + , Data.Language.Spec , Data.Range.Spec , Data.Scientific.Spec , Data.Semigroup.App.Spec diff --git a/src/Data/Language.hs b/src/Data/Language.hs index d21ee20c88..209b08f255 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -14,6 +14,7 @@ module Data.Language import Data.Aeson import qualified Data.Languages as Lingo import qualified Data.Text as T +import qualified Data.Map.Strict as Map import Prologue import System.FilePath.Posix @@ -129,7 +130,12 @@ languageForFilePath path = case Lingo.languageName <$> Lingo.languageForPath pat _ -> Unknown supportedExts :: [String] -supportedExts = [".go", ".py", ".rb", ".js", ".mjs", ".ts", ".php", ".phpt"] +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"] + lookup k = Map.lookup k Lingo.languages codeNavLanguages :: [Language] codeNavLanguages = [Go, Ruby, Python, JavaScript, TypeScript, PHP] diff --git a/test/Data/Language/Spec.hs b/test/Data/Language/Spec.hs new file mode 100644 index 0000000000..c9239c4e06 --- /dev/null +++ b/test/Data/Language/Spec.hs @@ -0,0 +1,12 @@ +module Data.Language.Spec (spec) where + +import Data.Language +import SpecHelpers + +spec :: Spec +spec = describe "Data.Language" $ do + it "supportedExts returns expected list" $ + supportedExts `shouldBe` [".go",".rb",".builder",".eye",".fcgi",".gemspec",".god",".jbuilder",".mspec",".pluginspec",".podspec",".rabl",".rake",".rbuild",".rbw",".rbx",".ru",".ruby",".spec",".thor",".watchr",".py",".bzl",".cgi",".fcgi",".gyp",".gypi",".lmi",".py3",".pyde",".pyi",".pyp",".pyt",".pyw",".rpy",".spec",".tac",".wsgi",".xpy",".js","._js",".bones",".es",".es6",".frag",".gs",".jake",".jsb",".jscad",".jsfl",".jsm",".jss",".mjs",".njs",".pac",".sjs",".ssjs",".xsjs",".xsjslib",".ts",".php",".aw",".ctp",".fcgi",".inc",".php3",".php4",".php5",".phps",".phpt"] + + it "codeNavLanguages returns expected list" $ + codeNavLanguages `shouldBe` [Go, Ruby, Python, JavaScript, TypeScript, PHP] diff --git a/test/Spec.hs b/test/Spec.hs index c58e8515f1..9b59ebccd4 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -14,6 +14,7 @@ import qualified Data.Abstract.Name.Spec import qualified Data.Abstract.Path.Spec import qualified Data.Functor.Classes.Generic.Spec import qualified Data.Graph.Spec +import qualified Data.Language.Spec import qualified Data.Range.Spec import qualified Data.Scientific.Spec import qualified Data.Semigroup.App.Spec @@ -78,6 +79,7 @@ legacySpecs = parallel $ do describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec + describe "Data.Language" Data.Language.Spec.spec describe "Data.Range" Data.Range.Spec.spec describe "Data.Scientific" Data.Scientific.Spec.spec describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec From 147604e59db7136b852e61bc6ac7f07b53987226 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 16 Aug 2019 14:06:49 -0700 Subject: [PATCH 3/5] 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 209b08f255..b1a5892a1c 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 82e82f5926..05613e1fd5 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 4e47f0da2b..e627b54445 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))) From 5763cfdfb6173e248e18337ed26f6539b9321853 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 19 Aug 2019 10:34:55 -0700 Subject: [PATCH 4/5] Use tasty for testing instead --- test/Data/Language/Spec.hs | 19 ++++++++++--------- test/Spec.hs | 2 +- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/test/Data/Language/Spec.hs b/test/Data/Language/Spec.hs index c9239c4e06..08e32cf18b 100644 --- a/test/Data/Language/Spec.hs +++ b/test/Data/Language/Spec.hs @@ -1,12 +1,13 @@ -module Data.Language.Spec (spec) where +module Data.Language.Spec (testTree) where import Data.Language -import SpecHelpers +import Test.Tasty +import Test.Tasty.HUnit -spec :: Spec -spec = describe "Data.Language" $ do - it "supportedExts returns expected list" $ - supportedExts `shouldBe` [".go",".rb",".builder",".eye",".fcgi",".gemspec",".god",".jbuilder",".mspec",".pluginspec",".podspec",".rabl",".rake",".rbuild",".rbw",".rbx",".ru",".ruby",".spec",".thor",".watchr",".py",".bzl",".cgi",".fcgi",".gyp",".gypi",".lmi",".py3",".pyde",".pyi",".pyp",".pyt",".pyw",".rpy",".spec",".tac",".wsgi",".xpy",".js","._js",".bones",".es",".es6",".frag",".gs",".jake",".jsb",".jscad",".jsfl",".jsm",".jss",".mjs",".njs",".pac",".sjs",".ssjs",".xsjs",".xsjslib",".ts",".php",".aw",".ctp",".fcgi",".inc",".php3",".php4",".php5",".phps",".phpt"] - - it "codeNavLanguages returns expected list" $ - codeNavLanguages `shouldBe` [Go, Ruby, Python, JavaScript, TypeScript, PHP] +testTree :: TestTree +testTree = testGroup "Data.Language" + [ testCase "supportedExts returns expected list" $ + supportedExts @=? [".go",".rb",".builder",".eye",".fcgi",".gemspec",".god",".jbuilder",".mspec",".pluginspec",".podspec",".rabl",".rake",".rbuild",".rbw",".rbx",".ru",".ruby",".spec",".thor",".watchr",".py",".bzl",".cgi",".fcgi",".gyp",".gypi",".lmi",".py3",".pyde",".pyi",".pyp",".pyt",".pyw",".rpy",".spec",".tac",".wsgi",".xpy",".js","._js",".bones",".es",".es6",".frag",".gs",".jake",".jsb",".jscad",".jsfl",".jsm",".jss",".mjs",".njs",".pac",".sjs",".ssjs",".xsjs",".xsjslib",".ts",".php",".aw",".ctp",".fcgi",".inc",".php3",".php4",".php5",".phps",".phpt"] + , testCase "codeNavLanguages returns expected list" $ + codeNavLanguages @=? [Go, Ruby, Python, JavaScript, TypeScript, PHP] + ] diff --git a/test/Spec.hs b/test/Spec.hs index 9b59ebccd4..1ed782dd28 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -47,6 +47,7 @@ tests :: (?session :: TaskSession) => [TestTree] tests = [ Integration.Spec.testTree , Semantic.CLI.Spec.testTree + , Data.Language.Spec.testTree , Data.Source.Spec.testTree , Semantic.Stat.Spec.testTree ] @@ -79,7 +80,6 @@ legacySpecs = parallel $ do describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec - describe "Data.Language" Data.Language.Spec.spec describe "Data.Range" Data.Range.Spec.spec describe "Data.Scientific" Data.Scientific.Spec.spec describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec From 691f1fd3e942b43ce2ac0aca3beffe58a32e7dde Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 19 Aug 2019 11:37:15 -0700 Subject: [PATCH 5/5] Switch over to lingo on hackage --- cabal.project | 5 ----- semantic.cabal | 2 +- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 75a29b096f..2a7af0f0f2 100644 --- a/cabal.project +++ b/cabal.project @@ -14,8 +14,3 @@ source-repository-package type: git location: https://github.com/joshvera/proto3-wire.git tag: 84664e22f01beb67870368f1f88ada5d0ad01f56 - -source-repository-package - type: git - location: https://github.com/tclem/lingo-haskell.git - tag: 7a453568556d7b6ab6fb4573b158b41cef56f7cc diff --git a/semantic.cabal b/semantic.cabal index a4a2ab8491..e7953aa898 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -73,7 +73,7 @@ common dependencies , unix ^>= 2.7.2.2 , proto3-suite , proto3-wire - , lingo + , lingo >= 0.1.0.1 common executable-flags ghc-options: -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m"