lingo (empty) → 0.1.0.0

raw patch · 6 files changed

+269/−0 lines, 6 filesdep +basedep +bytestringdep +containersbuild-type:Customsetup-changed

Dependencies added: base, bytestring, containers, filepath, hspec, lingo, raw-strings-qq, text, yaml

Files

LICENSE +30/−0
README.md +11/−0
Setup.hs +116/−0
lingo.cabal +52/−0
src/Data/Languages.hs +35/−0
test/Spec.hs +25/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Timothy Clem++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Timothy Clem nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,11 @@+# Lingo++Detect programming languages from file extensions and common filenames. Based on [linguist's](https://github.com/github/linguist) registry of languages.++## Development++```+cabal new-update+cabal new-configure+cabal new-build+```

+ Setup.hs view

@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import           Debug.Trace+import           Distribution.PackageDescription+import           Distribution.Simple hiding (Language)+import           Distribution.Simple.BuildPaths+import           Distribution.Simple.LocalBuildInfo+import           Distribution.Simple.Setup+import           System.Directory+import           System.FilePath.Posix ((</>))+import qualified Data.Map.Strict as Map+import           Data.Text (Text)+import           Data.Text.Encoding (encodeUtf8)+import qualified Data.Yaml as Y+import           Data.Yaml (FromJSON (..), (.!=), (.:), (.:?))++main = defaultMainWithHooks simpleUserHooks { postConf = conf }++conf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()+conf _ _ _ info = do+  let autogenDir = autogenPackageModulesDir info+  createDirectoryIfMissing True autogenDir+  traceM $ "Writing Gen_Languages.hs to autogenDir: " <> autogenDir+  dir <- getCurrentDirectory+  let yamlFile = dir </> "languages.yml"+  yaml <- B.readFile yamlFile+  B.writeFile (autogenDir </> "Gen_Languages.hs") (contents yaml)+  pure ()++contents :: B.ByteString -> B.ByteString+contents yaml =+  "module Gen_Languages where\n\+  \\n\+  \import Data.ByteString (ByteString)\n\+  \import Data.Text (Text)\n\+  \import qualified Data.Map.Strict as Map\n\+  \\n\+  \-- | Type synonym for linguist's language name key.\n\+  \type LanguageKey = Text\n\+  \\n\+  \-- | Identifies a programming language.\n\+  \data Language\n\+  \  = Language\n\+  \  { languageID         :: Integer\n\+  \  , languageName       :: Text\n\+  \  , languageExtensions :: [Text]\n\+  \  , languageFileNames  :: [Text]\n\+  \  } deriving (Eq, Show)\n\+  \\n\+  \-- | Complete map of programming languages known to linguist.\n\+  \languages :: Map.Map LanguageKey Language\n\+  \languages = Map.fromList\+  \  [\n    "+  <>+  either (BC.pack . show) (B.intercalate ",\n    ") langs+  <>+  "  ]\n\+  \\n\+  \-- | Map of languages by file extension.\n\+  \languagesByExtension :: Map.Map Text [LanguageKey]\n\+  \languagesByExtension = Map.fromList\+  \  [\n    "+  <>+  either (BC.pack . show) (B.intercalate ",\n    ") langsByExt+  <>+  "  ]\n\+  \\n\+  \-- | Map of languages by filename.\n\+  \languagesByFileName :: Map.Map Text [LanguageKey]\n\+  \languagesByFileName = Map.fromList\+  \  [\n    "+  <>+  either (BC.pack . show) (B.intercalate ",\n    ") langsByFileName+  <>+  "  ]\n\+  \"++  where+    langs = Map.foldrWithKey (\k v xs -> "(\"" <> encodeUtf8 k <> "\", " <> BC.pack (show v { languageName = k }) <> ")" : xs) mempty <$> languages+    langsByExt = Map.foldrWithKey (\k vs xs -> "(\"" <> encodeUtf8 k <> "\", [" <> showLanguages vs <> "])" : xs) mempty <$> languagesByExtension+    langsByFileName = Map.foldrWithKey (\k vs xs -> "(\"" <> encodeUtf8 k <> "\", [" <> showLanguages vs <> "])" : xs) mempty <$> languagesByFileName++    showLanguages = BC.intercalate ", " . fmap (wrap . encodeUtf8 . languageName)+    wrap x = "\"" <> x <> "\""++    languages :: Either Y.ParseException (Map.Map Text Language)+    languages = Y.decodeEither' yaml++    languagesByExtension :: Either Y.ParseException (Map.Map Text [Language])+    languagesByExtension = Map.foldrWithKey (buildMap languageExtensions) mempty <$> languages++    languagesByFileName :: Either Y.ParseException (Map.Map Text [Language])+    languagesByFileName = Map.foldrWithKey (buildMap languageFileNames) mempty <$> languages++    buildMap :: (Language -> [Text]) -> Text -> Language -> Map.Map Text [Language] -> Map.Map Text [Language]+    buildMap f k l m = foldr (\ext b -> Map.insertWith (<>) ext (pure lang) b) m (f lang)+      where lang = l { languageName = k }++data Language+  = Language+  { languageID         :: Integer+  , languageName       :: Text+  , languageExtensions :: [Text]+  , languageFileNames  :: [Text]+  } deriving (Eq, Show)++instance FromJSON Language where+  parseJSON (Y.Object v) =+    Language <$>+    v .: "language_id" <*>+    v .:? "language_name" .!= mempty <*>+    v .:? "extensions" .!= mempty <*>+    v .:? "filenames" .!= mempty+  parseJSON _ = fail "Expected Object for Language value"

+ lingo.cabal view

@@ -0,0 +1,52 @@+cabal-version:       2.4+build-type:          Custom+name:                lingo+version:             0.1.0.0+synopsis:            File extension based programming language detection+description:         Lingo uses github/linguist's language registry to enable fast detection of a file path's programming langauge based on extension or filename.+homepage:            https://github.com/tclem/lingo-haskell+license:             BSD-3-Clause+license-file:        LICENSE+author:              Timothy Clem+maintainer:          timothy.clem@gmail.com+category:            Data+extra-source-files:  README.md++custom-setup+  setup-depends:       Cabal+                     , base+                     , bytestring+                     , containers+                     , directory+                     , filepath+                     , text+                     , yaml++library+  exposed-modules: Data.Languages+  other-modules: Gen_Languages+  autogen-modules: Gen_Languages+  build-depends:       base ^>=4.12.0.0+                     , bytestring+                     , containers+                     , filepath+                     , raw-strings-qq+                     , text+                     , yaml+  hs-source-dirs:      src+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base ^>=4.12.0.0+                     , lingo+                     , hspec+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings++source-repository head+  type:     git+  location: https://github.com/tclem/lingo-haskell

+ src/Data/Languages.hs view

@@ -0,0 +1,35 @@+-- | Primary interface for looking up the programming language of a file or+-- interacting with languages known to linguist+-- (https://github.com/github/linguist).+module Data.Languages+  ( languageForPath+  , languages+  , languagesByExtension+  , languagesByFileName+  , LanguageKey+  , Language(..)+  ) where++import           Control.Applicative+import qualified Data.Map.Strict as Map+import           Data.Maybe+import           Data.Text (Text)+import qualified Data.Text as Text+import           Gen_Languages+import           System.FilePath.Posix++-- | Find the Language (if any) for a FilePath.+languageForPath :: FilePath -> Maybe Language+languageForPath path = languageForFileName <|> languageForExtension+  where+    languageForFileName = languageFor (takeFileName path) languagesByFileName+    languageForExtension = languageFor (takeExtension path) languagesByExtension+    languageFor k f = maybe Nothing lookupPrimary $ Map.lookup (Text.pack k) f++    -- Some extensions and filenames associate with multiple languages, this is+    -- a dumb way to specify which is the primary language.+    lookupPrimary xs+      | null xs = Nothing+      | "Markdown" `elem` xs = lookup "Markdown"+      | otherwise = lookup (head xs)+      where lookup k = Map.lookup k languages

+ test/Spec.hs view

@@ -0,0 +1,25 @@+module Main where++import Test.Hspec+import Data.Languages++main :: IO ()+main = hspec $ do+  describe "detect language for path" $ do+    it "can detect Ruby by file extension" $+      languageName <$> languageForPath "test.rb" `shouldBe` Just "Ruby"++    it "can detect Ruby by filename" $+      languageName <$> languageForPath "Rakefile" `shouldBe` Just "Ruby"++    it "returns Nothing for unknown files" $+      languageName <$> languageForPath "noideawhatthisis" `shouldBe` Nothing++    it "returns Nothing for unknown extensions" $+      languageName <$> languageForPath ".noideawhatthisis" `shouldBe` Nothing++  describe "languages" $+    it "parsed languages.yml" $ do+      length languages `shouldBe` 519+      length languagesByExtension `shouldBe` 1117+      length languagesByFileName `shouldBe` 235