semantic-source 0.0.1.0 → 0.0.2.0
raw patch · 5 files changed
+159/−3 lines, 5 filesdep +containersdep +lingodep +pathtypenew-uploader
Dependencies added: containers, lingo, pathtype
Files
- CHANGELOG.md +5/−0
- semantic-source.cabal +5/−1
- src/Source/Language.hs +136/−0
- src/Source/Loc.hs +6/−1
- src/Source/Range.hs +7/−1
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.0.2.0++- Adds `Source.Language`.+- Adds `ToJSON` instances for `Range` and `Loc`.+ # 0.0.1.0 - Adds an `NFData` instance for `Source`.
semantic-source.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: semantic-source-version: 0.0.1.0+version: 0.0.2.0 synopsis: Types and functionality for working with source code description: Types and functionality for working with source code (program text). homepage: https://github.com/github/semantic/tree/master/semantic-source#readme@@ -42,6 +42,7 @@ library import: haskell exposed-modules:+ Source.Language Source.Loc Source.Range Source.Source@@ -51,8 +52,11 @@ , base >= 4.12 && < 5 , bytestring ^>= 0.10.8.2 , deepseq ^>= 1.4.4.0+ , containers ^>= 0.6.2 , generic-monoid ^>= 0.1.0.0 , hashable >= 1.2.7 && < 1.4+ , lingo ^>= 0.3+ , pathtype ^>= 0.8.1 , semilattices ^>= 0.0.0.3 , text ^>= 1.2.3.1 hs-source-dirs: src
+ src/Source/Language.hs view
@@ -0,0 +1,136 @@+{-# 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+ | Python+ | Ruby+ | TypeScript+ | PHP+ | TSX+ deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Enum)++-- | Reifies a proxied type-level 'Language' to a value.+class SLanguage (lang :: Language) where+ reflect :: proxy lang -> Language++instance SLanguage 'Unknown where+ reflect _ = Unknown++instance SLanguage 'Go where+ reflect _ = Go++instance SLanguage 'Haskell where+ reflect _ = Haskell++instance SLanguage 'Java where+ reflect _ = Java++instance SLanguage 'JavaScript where+ reflect _ = JavaScript++instance SLanguage 'JSON where+ reflect _ = JSON++instance SLanguage 'JSX where+ reflect _ = JSX++instance SLanguage 'Markdown where+ reflect _ = Markdown++instance SLanguage 'Python where+ reflect _ = Python++instance SLanguage 'Ruby where+ reflect _ = Ruby++instance SLanguage 'TypeScript where+ reflect _ = TypeScript++instance SLanguage 'PHP where+ reflect _ = PHP++instance FromJSON Language where+ parseJSON = withText "Language" $ \l ->+ pure $ textToLanguage l+++-- | Predicate failing on 'Unknown' and passing in all other cases.+knownLanguage :: Language -> Bool+knownLanguage = (/= Unknown)++extensionsForLanguage :: Language -> [String]+extensionsForLanguage language = T.unpack <$> maybe mempty Lingo.languageExtensions (Map.lookup (languageToText language) Lingo.languages)++forPath :: Path.PartClass.AbsRel ar => Path.File ar -> Language+forPath path =+ let spurious lang = lang `elem` [ "Hack" -- .php files+ , "GCC Machine Description" -- .md files+ , "XML" -- .tsx files+ ]+ allResults = Lingo.languageName <$> Lingo.languagesForPath (Path.toString path)+ in case filter (not . spurious) allResults of+ [result] -> textToLanguage result+ _ -> Unknown++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
src/Source/Loc.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, DerivingVia, RankNTypes #-}+{-# LANGUAGE DeriveGeneric, DerivingVia, RankNTypes, NamedFieldPuns, OverloadedStrings #-} module Source.Loc ( Loc(..) , byteRange_@@ -7,6 +7,7 @@ ) where import Control.DeepSeq (NFData)+import Data.Aeson (ToJSON(..), object, (.=)) import Data.Hashable (Hashable) import Data.Monoid.Generic import GHC.Generics (Generic)@@ -28,6 +29,9 @@ span_ = lens span (\l s -> l { span = s }) {-# INLINE span_ #-} +instance ToJSON Loc where+ toJSON Loc{byteRange, span} = object ["sourceRange" .= byteRange+ , "sourceSpan" .= span] byteRange_ :: Lens' Loc Range byteRange_ = lens byteRange (\l r -> l { byteRange = r })@@ -38,3 +42,4 @@ lens :: (s -> a) -> (s -> a -> s) -> Lens' s a lens get put afa s = fmap (put s) (afa (get s)) {-# INLINE lens #-}+
src/Source/Range.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, RankNTypes #-}+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, RankNTypes, NamedFieldPuns #-} module Source.Range ( Range(..) , point@@ -10,6 +10,7 @@ ) where import Control.DeepSeq (NFData)+import Data.Aeson (ToJSON(..)) import Data.Hashable (Hashable) import Data.Semilattice.Lower (Lower(..)) import GHC.Generics (Generic)@@ -24,6 +25,8 @@ instance Hashable Range instance NFData Range ++ -- $ -- prop> a <> (b <> c) === (a <> b) <> (c :: Range) instance Semigroup Range where@@ -32,6 +35,8 @@ instance Lower Range where lowerBound = Range 0 0 +instance ToJSON Range where+ toJSON Range { start, end } = toJSON [ start, end ] -- | Construct a 'Range' with a given value for both its start and end indices. point :: Int -> Range@@ -60,3 +65,4 @@ -- $setup -- >>> import Test.QuickCheck -- >>> instance Arbitrary Range where arbitrary = Range <$> arbitrary <*> arbitrary ; shrink (Range s e) = Range <$> shrink s <*> shrink e+