hsdev 0.1.5.1 → 0.1.5.2

raw patch · 5 files changed

+93/−43 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hsdev.cabal +3/−3
• src/HsDev/Commands.hs +11/−13
• src/HsDev/Symbols/Types.hs +32/−24
• src/HsDev/Tools/Ghc/Prelude.hs +36/−1
• src/HsDev/Util.hs +11/−2

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.5.1
+version:             0.1.5.2
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -110,7 +110,7 @@     ghc-paths >= 0.1.0,
     ghc-syb-utils >= 0.2.3,
     haddock-api >= 2.16.0 && < 2.17.0,
-    haskell-src-exts >= 1.16.0,
+    haskell-src-exts >= 1.17.0 && < 1.18.0,
     hdocs >= 0.4.4,
     hformat >= 0.1,
     hlint >= 1.9.0 && < 2.0.0,
@@ -199,7 +199,7 @@     containers >= 0.5.0,
     directory >= 1.2.0,
     ghc >= 7.10.0 && < 7.11.0,
-    haskell-src-exts >= 1.16.0,
+    haskell-src-exts >= 1.17.0 && < 1.18.0,
     lens >= 4.8,
     mtl >= 2.2.0,
     optparse-applicative >= 0.11,

@@ -24,7 +24,7 @@ 	) where
 
 import Control.Applicative
-import Control.Lens (view, set, each)
+import Control.Lens (view, set, each, toListOf)
 import Control.Monad.Except
 import Data.List (delete)
 import Data.Maybe
@@ -84,13 +84,12 @@ 		(qname, iname) = splitIdentifier ident
 
 -- | Whois symbol in scope
-whois :: Database -> Cabal -> FilePath -> String -> ExceptT String IO [ModuleDeclaration]
+whois :: Database -> Cabal -> FilePath -> String -> ExceptT String IO [Declaration]
 whois db cabal file ident = do
 	(_, mthis, mproj) <- fileCtx db file
 	return $
-		newestPackage $ filter (checkDecl . view moduleDeclaration) $
-		moduleModuleDeclarations $ scopeModule $
-		resolveOne (fileDeps file cabal mproj db) $
+		newestPackage $ filter checkDecl $
+		view moduleDeclarations $ scopeModule $ resolveOne (fileDeps file cabal mproj db) $
 		moduleLocals mthis
 	where
 		(qname, iname) = splitIdentifier ident
@@ -110,20 +109,19 @@ 		deps f p = delete (view projectName p) $ concatMap (view infoDepends) $ fileTargets p f
 
 -- | Symbols in scope
-scope :: Database -> Cabal -> FilePath -> Bool -> ExceptT String IO [ModuleDeclaration]
+scope :: Database -> Cabal -> FilePath -> Bool -> ExceptT String IO [Declaration]
 scope db cabal file False = do
 	(_, mthis, mproj) <- fileCtx db file
-	return $ moduleModuleDeclarations $ scopeModule $ resolveOne (fileDeps file cabal mproj db) mthis
-scope db cabal file True = concatMap moduleModuleDeclarations <$> scopeModules db cabal file
+	return $ view moduleDeclarations $ scopeModule $ resolveOne (fileDeps file cabal mproj db) mthis
+scope db cabal file True = concatMap (view moduleDeclarations) <$> scopeModules db cabal file
 
 -- | Completions
-completions :: Database -> Cabal -> FilePath -> String -> Bool -> ExceptT String IO [ModuleDeclaration]
+completions :: Database -> Cabal -> FilePath -> String -> Bool -> ExceptT String IO [Declaration]
 completions db cabal file prefix wide = do
 	(_, mthis, mproj) <- fileCtx db file
 	return $
-		newestPackage $ filter (checkDecl . view moduleDeclaration) $
-		moduleModuleDeclarations $ scopeModule $
-		resolveOne (fileDeps file cabal mproj db) $
+		toListOf (each . minimalDecl) $ newestPackage $ filter checkDecl $
+		view moduleDeclarations $ scopeModule $ resolveOne (fileDeps file cabal mproj db) $
 		dropImportLists mthis
 	where
 		(qname, iname) = splitIdentifier prefix
@@ -161,7 +159,7 @@ splitIdentifier :: String -> (Maybe String, String)
 splitIdentifier name = fromMaybe (Nothing, name) $ do
 	groups <- matchRx "(([A-Z][\\w']*\\.)*)(.*)" name
-	return (fmap dropDot $ groups 1, groups `at_` 3)
+	return (dropDot <$> groups 1, groups `at_` 3)
 	where
 		dropDot :: String -> String
 		dropDot "" = ""

@@ -8,7 +8,7 @@ 	Import(..),
 	ModuleId(..),
 	Module(..), moduleContents, moduleId,
-	Declaration(..),
+	Declaration(..), minimalDecl,
 	TypeInfo(..), showTypeInfo,
 	DeclarationInfo(..), declarationInfo, declarationTypeCtor, declarationTypeName,
 	ModuleDeclaration(..),
@@ -36,7 +36,7 @@ 
 import Control.Applicative
 import Control.Arrow
-import Control.Lens (makeLenses, view, set, Simple, Lens, lens)
+import Control.Lens (makeLenses, view, set, Simple, Lens, Lens', lens)
 import Control.Monad
 import Control.DeepSeq (NFData(..))
 import Data.Aeson
@@ -50,7 +50,7 @@ import HsDev.Project
 import HsDev.Symbols.Class
 import HsDev.Symbols.Documented
-import HsDev.Util (tab, tabs, (.::))
+import HsDev.Util (tab, tabs, (.::), (.::?), (.::?!), noNulls)
 
 -- | What to export for data/class etc
 data ExportPart = ExportNothing | ExportAll | ExportWith [Text] deriving (Eq, Ord)
@@ -150,7 +150,7 @@ 		maybe "" ((" " ++) . show) (_importList i)]
 
 instance ToJSON Import where
-	toJSON i = object [
+	toJSON i = object $ noNulls [
 		"name" .= _importModuleName i,
 		"qualified" .= _importIsQualified i,
 		"as" .= _importAs i,
@@ -161,9 +161,9 @@ 	parseJSON = withObject "import" $ \v -> Import <$>
 		v .:: "name" <*>
 		v .:: "qualified" <*>
-		v .:: "as" <*>
-		v .:: "import-list" <*>
-		v .:: "pos"
+		v .::? "as" <*>
+		v .::? "import-list" <*>
+		v .::? "pos"
 
 -- | Module id
 data ModuleId = ModuleId {
@@ -198,7 +198,7 @@ 		deriving (Ord)
 
 instance ToJSON Module where
-	toJSON m = object [
+	toJSON m = object $ noNulls [
 		"name" .= _moduleName m,
 		"docs" .= _moduleDocs m,
 		"location" .= _moduleLocation m,
@@ -209,11 +209,11 @@ instance FromJSON Module where
 	parseJSON = withObject "module" $ \v -> Module <$>
 		v .:: "name" <*>
-		v .:: "docs" <*>
+		v .::? "docs" <*>
 		v .:: "location" <*>
-		v .:: "exports" <*>
-		v .:: "imports" <*>
-		v .:: "declarations"
+		v .::? "exports" <*>
+		v .::?! "imports" <*>
+		v .::?! "declarations"
 
 instance NFData Module where
 	rnf (Module n d s e i ds) = rnf n `seq` rnf d `seq` rnf s `seq` rnf e `seq` rnf i `seq` rnf ds
@@ -263,7 +263,7 @@ 		maybe "" (("\tlocation: " ++ ) . show) $ _declarationPosition d]
 
 instance ToJSON Declaration where
-	toJSON d = object [
+	toJSON d = object $ noNulls [
 		"name" .= _declarationName d,
 		"defined" .= _declarationDefined d,
 		"imported" .= _declarationImported d,
@@ -274,12 +274,20 @@ instance FromJSON Declaration where
 	parseJSON = withObject "declaration" $ \v -> Declaration <$>
 		v .:: "name" <*>
-		v .:: "defined" <*>
-		v .:: "imported" <*>
-		v .:: "docs" <*>
-		v .:: "pos" <*>
+		v .::? "defined" <*>
+		v .::? "imported" <*>
+		v .::? "docs" <*>
+		v .::? "pos" <*>
 		v .:: "decl"
 
+-- | Minimal declaration info without defined, docs and position
+minimalDecl :: Lens' Declaration Declaration
+minimalDecl = lens to' from' where
+	to' :: Declaration -> Declaration
+	to' decl' = decl' { _declarationDefined = Nothing, _declarationDocs = Nothing, _declarationPosition = Nothing }
+	from' :: Declaration -> Declaration -> Declaration
+	from' decl' mdecl = decl' { _declarationName = _declarationName mdecl, _declarationImported = _declarationImported mdecl, _declaration = _declaration mdecl }
+
 -- | Common info for type, newtype, data and class
 data TypeInfo = TypeInfo {
 	_typeInfoContext :: Maybe Text,
@@ -292,7 +300,7 @@ 	rnf (TypeInfo c a d f) = rnf c `seq` rnf a `seq` rnf d `seq` rnf f
 
 instance ToJSON TypeInfo where
-	toJSON t = object [
+	toJSON t = object $ noNulls [
 		"ctx" .= _typeInfoContext t,
 		"args" .= _typeInfoArgs t,
 		"def" .= _typeInfoDefinition t,
@@ -300,10 +308,10 @@ 
 instance FromJSON TypeInfo where
 	parseJSON = withObject "type info" $ \v -> TypeInfo <$>
-		v .:: "ctx" <*>
-		v .:: "args" <*>
-		v .:: "def" <*>
-		v .:: "funs"
+		v .::? "ctx" <*>
+		v .::?! "args" <*>
+		v .::? "def" <*>
+		v .::?! "funs"
 
 showTypeInfo :: TypeInfo -> String -> String -> String
 showTypeInfo ti pre name = concat [
@@ -361,14 +369,14 @@ 
 instance ToJSON DeclarationInfo where
 	toJSON i = case declarationInfo i of
-		Left (t, ds, r) -> object ["what" .= ("function" :: String), "type" .= t, "locals" .= ds, "related" .= r]
+		Left (t, ds, r) -> object $ noNulls ["what" .= ("function" :: String), "type" .= t, "locals" .= ds, "related" .= r]
 		Right ti -> object ["what" .= declarationTypeName i, "info" .= ti]
 
 instance FromJSON DeclarationInfo where
 	parseJSON = withObject "declaration info" $ \v -> do
 		w <- fmap (id :: String -> String) $ v .:: "what"
 		if w == "function"
-			then Function <$> v .:: "type" <*> v .:: "locals" <*> v .:: "related"
+			then Function <$> v .::? "type" <*> v .::?! "locals" <*> v .::? "related"
 			else declarationTypeCtor w <$> v .:: "info"
 
 -- | Symbol in context of some module

@@ -1,33 +1,43 @@ module HsDev.Tools.Ghc.Prelude (
 	reduce, one, trim,
+	-- * Regexes
 	rx, srx, splitRx,
+	-- * Case
+	lowerCase, upperCase, titleCase, camelCase, underscoreCase,
 
+	module Control.Lens,
 	module Data.Char,
 	module Data.List,
 	module Data.Maybe
 	) where
 
+import Control.Lens
 import Data.Array (assocs)
 import Data.Char
-import Data.List
+import Data.List hiding (uncons)
 import Data.Maybe
 import Text.Regex.PCRE
 
+-- | Reduce list to one element
 reduce :: ([a] -> a) -> [a] -> [a]
 reduce = (return .)
 
+-- | Make list from single element
 one :: a -> [a]
 one = return
 
+-- | Trim string
 trim :: String -> String
 trim = p . p where
 	p = reverse . dropWhile isSpace
 
+-- | Match regex
 rx :: String -> String -> Maybe String
 rx r s = case s =~ r of
 	"" -> Nothing
 	res -> Just res
 
+-- | Replace regex
 srx :: String -> String -> String -> String
 srx pat s = concat . unfoldr split' . Just where
 	split' :: Maybe String -> Maybe (String, Maybe String)
@@ -49,6 +59,7 @@ 					(num, tl) -> fromMaybe "" (look $ read num) ++ subst' tl
 				subst' (s':ss') = s' : subst' ss'
 
+-- | Split by regex
 splitRx :: String -> String -> [String]
 splitRx pat = unfoldr split' . Just where
 	split' :: Maybe String -> Maybe (String, Maybe String)
@@ -58,3 +69,27 @@ 		_ -> Just (mrBefore r, Just $ mrAfter r)
 		where
 			r = str =~ pat
+
+lowerCase :: String -> String
+lowerCase = map toLower
+
+upperCase :: String -> String
+upperCase = map toUpper
+
+-- | Convert to title case
+titleCase :: String -> String
+titleCase = over _head toUpper
+
+-- | Convert to camel case
+camelCase :: String -> String
+camelCase = concatMap titleCase . splitRx "[\\s_]+"
+
+-- | Convert to underscore case
+underscoreCase :: String -> String
+underscoreCase = intercalate "_" . map lowerCase . unfoldr break' where
+	break' :: String -> Maybe (String, String)
+	break' str = do
+		(s, ss) <- uncons str
+		let
+			(h, tl) = break isUpper ss
+		return (s:h, tl)

@@ -12,7 +12,7 @@ 	-- * Other utils
 	ordNub, uniqueBy, mapBy,
 	-- * Helper
-	(.::), (.::?), objectUnion, jsonUnion,
+	(.::), (.::?), (.::?!), objectUnion, jsonUnion, noNulls,
 	-- * Exceptions
 	liftException, liftE, liftEIO, tries, triesMap, liftExceptionM, liftIOErrors,
 	eitherT,
@@ -43,7 +43,7 @@ import Data.Char (isSpace)
 import Data.List (isPrefixOf, unfoldr)
 import qualified Data.Map as M
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Set as Set
 import qualified Data.HashMap.Strict as HM (HashMap, toList, union)
 import qualified Data.ByteString.Char8 as B
@@ -150,6 +150,9 @@ (.::?) :: FromJSON a => HM.HashMap Text Value -> Text -> A.Parser (Maybe a)
 v .::? name = traverse parseJSON $ lookup name $ HM.toList v
 
+(.::?!) :: FromJSON a => HM.HashMap Text Value -> Text -> A.Parser [a]
+v .::?! name = fromMaybe [] <$> (v .::? name)
+
 -- | Union two JSON objects
 objectUnion :: Value -> Value -> Value
 objectUnion (Object l) (Object r) = Object $ HM.union l r
@@ -160,6 +163,12 @@ -- | Union two JSON objects
 jsonUnion :: (ToJSON a, ToJSON b) => a -> b -> Value
 jsonUnion x y = objectUnion (toJSON x) (toJSON y)
+
+-- | No Nulls in JSON object
+noNulls :: [A.Pair] -> [A.Pair]
+noNulls = filter (not . isNull . snd) where
+	isNull Null = True
+	isNull v = v == A.emptyArray || v == A.emptyObject
 
 -- | Lift IO exception to ExceptT
 liftException :: C.MonadCatch m => m a -> ExceptT String m a