hsdev 0.2.1.0 → 0.2.2.0

raw patch · 18 files changed

+571/−530 lines, 18 filesdep ~directorydep ~haskell-src-extsdep ~simple-log

Dependency ranges changed: directory, haskell-src-exts, simple-log

Files

hsdev.cabal +7/−7
src/HsDev/Client/Commands.hs +1/−1
src/HsDev/Inspect.hs +467/−467
src/HsDev/Project.hs +6/−2
src/HsDev/Sandbox.hs +5/−3
src/HsDev/Server/Commands.hs +22/−22
src/HsDev/Stack.hs +2/−1
src/HsDev/Symbols.hs +3/−3
src/HsDev/Tools/Base.hs +19/−0
src/HsDev/Tools/ClearImports.hs +1/−1
src/HsDev/Tools/Ghc/Check.hs +1/−0
src/HsDev/Tools/Ghc/MGhc.hs +0/−3
src/HsDev/Tools/HDocs.hs +2/−4
src/HsDev/Util.hs +6/−3
tests/Test.hs +10/−6
tests/test-package/ModuleOne.hs +2/−2
tests/test-package/ModuleTwo.hs +14/−3
tests/test-package/test-package.cabal +3/−2

hsdev.cabal view

@@ -1,5 +1,5 @@ name:                hsdev
-version:             0.2.1.0
+version:             0.2.2.0
 synopsis:            Haskell development library
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.
@@ -128,9 +128,9 @@     fsnotify >= 0.2.1,
     ghc-paths >= 0.1.0,
     ghc-syb-utils >= 0.2.3,
-    haskell-src-exts >= 1.18.0 && < 1.19.0,
+    haskell-src-exts >= 1.18.0 && < 1.20.0,
     hdocs >= 0.5.0,
-    hformat >= 0.1,
+    hformat == 0.1.*,
     hlint >= 1.9.13 && < 2.0.0,
     HTTP >= 4000.2.0,
     lens >= 4.8,
@@ -143,11 +143,11 @@     process >= 1.2.0,
     regex-pcre-builtin >= 0.94,
     scientific >= 0.3,
-    simple-log >= 0.5.0,
+    simple-log >= 0.5 && < 0.6,
     syb >= 0.5.1,
     template-haskell,
     text >= 1.2.0,
-    text-region >= 0.1,
+    text-region >= 0.1 && < 0.2,
     time >= 1.5.0,
     transformers >= 0.4.0,
     transformers-base >= 0.4.0,
@@ -217,7 +217,7 @@     containers >= 0.5.0,
     data-default >= 0.5.0,
     directory >= 1.2.0,
-    haskell-src-exts >= 1.18.0 && < 1.19.0,
+    haskell-src-exts >= 1.18.0 && < 1.20.0,
     lens >= 4.8,
     mtl >= 2.2.0,
     optparse-applicative >= 0.11,
@@ -301,7 +301,7 @@     directory >= 1.2.0,
     filepath >= 1.4.0,
     containers >= 0.5.0,
-    hformat >= 0.1,
+    hformat == 0.1.*,
     hspec,
     lens >= 4.8,
     mtl >= 2.2.0,

src/HsDev/Client/Commands.hs view

@@ -209,7 +209,7 @@ runCommand (CheckLint fs ghcs') = toValue $ do
 	ensureUpToDate (Update.UpdateOptions [] ghcs' False False) fs
 	let
-		checkSome file fn = do
+		checkSome file fn = Log.scope "checkSome" $ do
 			m <- setFileSourceSession ghcs' file
 			inSessionGhc $ fn m
 	checkMsgs <- liftM concat $ mapM (\(FileSource f c) -> checkSome f (\m -> Check.check ghcs' m c)) fs

src/HsDev/Inspect.hs view

@@ -1,467 +1,467 @@-{-# LANGUAGE TypeSynonymInstances #-}--module HsDev.Inspect (-	analyzeModule, inspectDocsChunk, inspectDocs, inspectDocsGhc,-	inspectContents, contentsInspection,-	inspectFile, fileInspection,-	projectDirs, projectSources,-	inspectProject,-	getDefines,-	preprocess, preprocess_,--	module Control.Monad.Except-	) where--import Control.Arrow-import Control.Applicative-import Control.DeepSeq-import qualified Control.Exception as E-import Control.Lens (view, preview, set, over)-import Control.Lens.At (ix)-import Control.Monad-import Control.Monad.Except-import Data.Char (isSpace)-import Data.Function (on)-import Data.List-import Data.Map (Map)-import Data.Maybe (fromMaybe, mapMaybe, catMaybes, listToMaybe, isJust)-import Data.Ord (comparing)-import Data.String (IsString, fromString)-import Data.Text (Text)-import qualified Data.Text as T (unpack)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, getPOSIXTime)-import qualified Data.Map as M-import qualified Language.Haskell.Exts as H-import qualified Language.Preprocessor.Cpphs as Cpphs-import qualified System.Directory as Dir-import System.FilePath-import Data.Generics.Uniplate.Data-import HDocs.Haddock--import HsDev.Error-import HsDev.Symbols-import HsDev.Tools.Base-import HsDev.Tools.Ghc.Worker ()-import HsDev.Tools.HDocs (hdocsy, hdocs, hdocsProcess)-import HsDev.Util---- | Analize source contents-analyzeModule :: [String] -> Maybe FilePath -> String -> Either String Module-analyzeModule exts file source = case H.parseFileContentsWithMode (parseMode file exts) source' of-	H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason-	H.ParseOk (H.Module _ (Just (H.ModuleHead _ (H.ModuleName _ mname) _ mexports)) _ imports declarations) -> Right Module {-		_moduleName = fromString mname,-		_moduleDocs =  Nothing,-		_moduleLocation = ModuleSource Nothing,-		_moduleExports = fmap (concatMap getExports . getSpec) mexports,-		_moduleImports = map getImport imports,-		_moduleDeclarations = sortDeclarations $ getDecls declarations }-	_ -> Left "Unknown module"-	where-		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces-		source' = map untab source-		untab '\t' = ' '-		untab ch = ch-		getSpec (H.ExportSpecList _ es) = es---- | Analize source contents-analyzeModule_ :: [String] -> Maybe FilePath -> String -> Either String Module-analyzeModule_ exts file source = do-	mname <- parseModuleName source'-	return Module {-		_moduleName = fromString mname,-		_moduleDocs = Nothing,-		_moduleLocation = ModuleSource Nothing,-		_moduleExports = do-			H.PragmasAndModuleHead _ _ mhead <- parseModuleHead' source'-			H.ModuleHead _ _ _ mexports <- mhead-			H.ExportSpecList _ exports <- mexports-			return $ concatMap getExports exports,-		_moduleImports = map getImport $ mapMaybe (uncurry parseImport') parts,-		_moduleDeclarations = sortDeclarations $ getDecls $ mapMaybe (uncurry parseDecl') parts }-	where-		parts :: [(Int, String)]-		parts = zip offsets (map unlines parts') where-			parts' :: [[String]]-			parts' = unfoldr break' $ lines source'-			offsets = scanl (+) 0 $ map length parts'-		break' :: [String] -> Maybe ([String], [String])-		break' [] = Nothing-		break' (l:ls) = Just $ first (l:) $ span (maybe True isSpace . listToMaybe) ls--		parseModuleName :: String -> Either String String-		parseModuleName cts = maybe (Left "match fail") Right $ do-			g <- matchRx "^module\\s+([\\w\\.]+)" cts-			g 1--		parseDecl' :: Int -> String -> Maybe (H.Decl H.SrcSpanInfo)-		parseDecl' offset cts = maybeResult $ fmap (transformBi $ addOffset offset) $-			H.parseDeclWithMode (parseMode file exts) cts--		parseImport' :: Int -> String -> Maybe (H.ImportDecl H.SrcSpanInfo)-		parseImport' offset cts = maybeResult $ fmap (transformBi $ addOffset offset) $-			H.parseImportDeclWithMode (parseMode file exts) cts--		parseModuleHead' :: String -> Maybe (H.PragmasAndModuleHead H.SrcSpanInfo)-		parseModuleHead' = maybeResult . fmap H.unNonGreedy . H.parseWithMode (parseMode file exts)--		maybeResult :: H.ParseResult a -> Maybe a-		maybeResult (H.ParseFailed _ _) = Nothing-		maybeResult (H.ParseOk r) = Just r--		addOffset :: Int -> H.SrcSpan -> H.SrcSpan-		addOffset offset src = src { H.srcSpanStartLine = H.srcSpanStartLine src + offset, H.srcSpanEndLine = H.srcSpanEndLine src + offset }--		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces-		source' = map untab source-		untab '\t' = ' '-		untab ch = ch--parseMode :: Maybe FilePath -> [String] -> H.ParseMode-parseMode file exts = H.defaultParseMode {-	H.parseFilename = fromMaybe (H.parseFilename H.defaultParseMode) file,-	H.baseLanguage = H.Haskell2010,-	H.extensions = H.glasgowExts ++ map H.parseExtension exts,-	H.fixities = Just H.baseFixities }---- | Get exports-getExports :: H.ExportSpec H.SrcSpanInfo -> [Export]-getExports (H.EModuleContents _ (H.ModuleName _ m)) = [ExportModule $ fromString m]-getExports (H.EVar _ n) = [uncurry ExportName (identOfQName n) ThingNothing]-getExports (H.EAbs _ _ n) = [uncurry ExportName (identOfQName n) ThingNothing]-getExports (H.EThingWith _ _ n ns) = [uncurry ExportName (identOfQName n) $ ThingWith (map toStr ns)] where-	toStr :: H.CName H.SrcSpanInfo -> Text-	toStr (H.VarName _ cn) = identOfName cn-	toStr (H.ConName _ cn) = identOfName cn---- | Get import-getImport :: H.ImportDecl H.SrcSpanInfo -> Import-getImport d = Import-	(mname (H.importModule d))-	(H.importQualified d)-	(mname <$> H.importAs d)-	(importLst <$> H.importSpecs d)-	(Just $ toPosition $ H.ann d)-	where-		mname (H.ModuleName _ n) = fromString n-		importLst (H.ImportSpecList _ hiding specs) = ImportList hiding $ map impSpec specs-		impSpec (H.IVar _ n) = ImportSpec (identOfName n) ThingNothing-		impSpec (H.IAbs _ _ n) = ImportSpec (identOfName n) ThingNothing-		impSpec (H.IThingAll _ n) = ImportSpec (identOfName n) ThingAll-		impSpec (H.IThingWith _ n ns) = ImportSpec (identOfName n) $ ThingWith $ map identOfName (concatMap childrenBi ns :: [H.Name H.SrcSpanInfo])---- | Decl declarations-getDecls :: [H.Decl H.SrcSpanInfo] -> [Declaration]-getDecls decls =-	map mergeDecls .-	groupBy ((==) `on` view declarationName) .-	sortBy (comparing (view declarationName)) $-	concatMap getDecl decls ++ concatMap getDef decls-	where-		mergeDecls :: [Declaration] -> Declaration-		mergeDecls [] = error "Impossible"-		mergeDecls ds = Declaration-			(view declarationName $ head ds)-			Nothing-			Nothing-			(msum $ map (view declarationDocs) ds)-			(minimum <$> mapM (view declarationPosition) ds)-			(foldr1 mergeInfos $ map (view declaration) ds)--		mergeInfos :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo-		mergeInfos (Function ln ld lr) (Function rn rd rr) = Function (ln `mplus` rn) (ld ++ rd) (lr `mplus` rr)-		mergeInfos l _ = l---- | Get local binds-getLocalDecls :: H.Decl H.SrcSpanInfo -> [Declaration]-getLocalDecls decl' = concatMap getDecls' binds' where-	binds' :: [H.Binds H.SrcSpanInfo]-	binds' = universeBi decl'-	getDecls' :: H.Binds H.SrcSpanInfo -> [Declaration]-	getDecls' (H.BDecls _ decls) = getDecls decls-	getDecls' _ = []---- | Get declaration and child declarations-getDecl :: H.Decl H.SrcSpanInfo -> [Declaration]-getDecl decl' = case decl' of-	H.TypeSig loc names typeSignature -> [mkFun loc n (Function (Just $ oneLinePrint typeSignature) [] Nothing) | n <- names]-	H.TypeDecl loc h _ -> [mkType loc (tyName h) Type (tyArgs h) `withDef` decl']-	H.DataDecl loc dataOrNew mctx h cons _ -> (mkType loc (tyName h) (ctor dataOrNew `withCtx` mctx) (tyArgs h) `withDef` decl') : concatMap (map (addRel $ tyName h) . getConDecl (tyName h) (tyArgs h)) cons-	H.GDataDecl loc dataOrNew mctx h _ gcons _ -> (mkType loc (tyName h) (ctor dataOrNew `withCtx` mctx) (tyArgs h) `withDef` decl') : concatMap (map (addRel $ tyName h) . getGConDecl) gcons-	H.ClassDecl loc ctx h _ _ -> [mkType loc (tyName h) (Class `withCtx` ctx) (tyArgs h) `withDef` decl']-	_ -> []-	where-		mkType :: H.SrcSpanInfo -> H.Name H.SrcSpanInfo -> (TypeInfo -> DeclarationInfo) -> [H.TyVarBind H.SrcSpanInfo] -> Declaration-		mkType loc n ctor' args = setPosition loc $ decl (identOfName n) $ ctor' $ TypeInfo Nothing (map oneLinePrint args) Nothing []--		withDef :: H.Pretty a => Declaration -> a -> Declaration-		withDef tyDecl' tyDef = set (declaration . typeInfo . typeInfoDefinition) (Just $ prettyPrint tyDef) tyDecl'--		withCtx :: (TypeInfo -> DeclarationInfo) -> Maybe (H.Context H.SrcSpanInfo) -> TypeInfo -> DeclarationInfo-		withCtx ctor' mctx = ctor' . set typeInfoContext (fmap makeCtx mctx)--		ctor :: H.DataOrNew H.SrcSpanInfo -> TypeInfo -> DeclarationInfo-		ctor (H.DataType _) = Data-		ctor (H.NewType _) = NewType--		makeCtx ctx = fromString $ oneLinePrint ctx--		addRel :: H.Name H.SrcSpanInfo -> Declaration -> Declaration-		addRel n = set (declaration . related) (Just $ identOfName n)--		tyName :: H.DeclHead H.SrcSpanInfo -> H.Name H.SrcSpanInfo-		tyName (H.DHead _ n) = n-		tyName (H.DHInfix _ _ n) = n-		tyName (H.DHParen _ h) = tyName h-		tyName (H.DHApp _ h _) = tyName h--		tyArgs :: H.DeclHead H.SrcSpanInfo -> [H.TyVarBind H.SrcSpanInfo]-		tyArgs = universeBi---- | Get constructor and record fields declarations-getConDecl :: H.Name H.SrcSpanInfo -> [H.TyVarBind H.SrcSpanInfo] -> H.QualConDecl H.SrcSpanInfo -> [Declaration]-getConDecl t as (H.QualConDecl loc _ _ cdecl) = case cdecl of-	H.ConDecl _ n cts -> [mkFun loc n (Function (Just $ oneLinePrint $ cts `tyFun` dataRes) [] Nothing)]-	H.InfixConDecl _ ct n cts -> [mkFun loc n (Function (Just $ oneLinePrint $ (ct : [cts]) `tyFun` dataRes) [] Nothing)]-	H.RecDecl _ n fields -> mkFun loc n (Function (Just $ oneLinePrint $ map tyField fields `tyFun` dataRes) [] Nothing) : concatMap (getRec loc dataRes) fields-	where-		dataRes :: H.Type H.SrcSpanInfo-		dataRes = foldr (H.TyApp loc . H.TyVar loc . nameOf) (H.TyCon loc (H.UnQual loc t)) as where-			nameOf :: H.TyVarBind H.SrcSpanInfo -> H.Name H.SrcSpanInfo-			nameOf (H.KindedVar _ n' _) = n'-			nameOf (H.UnkindedVar _ n') = n'--tyField :: H.FieldDecl H.SrcSpanInfo -> H.Type H.SrcSpanInfo-tyField (H.FieldDecl _ _ t) = t---- | Get GADT constructor and record fields declarations-getGConDecl :: H.GadtDecl H.SrcSpanInfo -> [Declaration]-getGConDecl (H.GadtDecl loc n mfields r) = mkFun loc n (Function (Just $ oneLinePrint $ map tyField (fromMaybe [] mfields) `tyFun` r) [] Nothing) : concatMap (getRec loc r) (fromMaybe [] mfields)---- | Get record field declaration-getRec :: H.SrcSpanInfo -> H.Type H.SrcSpanInfo -> H.FieldDecl H.SrcSpanInfo -> [Declaration]-getRec loc t (H.FieldDecl _ ns rt) = [mkFun loc n (Function (Just $ oneLinePrint $ H.TyFun loc t rt) [] Nothing) | n <- ns]---- | Get definitions-getDef :: H.Decl H.SrcSpanInfo -> [Declaration]-getDef (H.FunBind _ []) = []-getDef d@(H.FunBind _ (m : _)) = [setPosition (H.ann m) $ decl (identOfName $ identOfMatch m) fun] where-	identOfMatch (H.Match _ n _ _ _) = n-	identOfMatch (H.InfixMatch _ _ n _ _ _) = n-	fun = Function Nothing (getLocalDecls d) Nothing-getDef d@(H.PatBind loc pat _ _) = map (\name -> setPosition loc (decl (identOfName name) (Function Nothing (getLocalDecls d) Nothing))) (names pat) where-	names :: H.Pat H.SrcSpanInfo -> [H.Name H.SrcSpanInfo]-	names (H.PVar _ n) = [n]-	names (H.PNPlusK _ n _) = [n]-	names (H.PInfixApp _ l _ r) = names l ++ names r-	names (H.PApp _ _ ns) = concatMap names ns-	names (H.PTuple _ _ ns) = concatMap names ns-	names (H.PList _ ns) = concatMap names ns-	names (H.PParen _ n) = names n-	names (H.PRec _ _ pf) = concatMap fieldNames pf-	names (H.PAsPat _ n ns) = n : names ns-	names (H.PWildCard _) = []-	names (H.PIrrPat _ n) = names n-	names (H.PatTypeSig _ n _) = names n-	names (H.PViewPat _ _ n) = names n-	names (H.PBangPat _ n) = names n-	names _ = []--	fieldNames :: H.PatField H.SrcSpanInfo -> [H.Name H.SrcSpanInfo]-	fieldNames (H.PFieldPat _ _ n) = names n-	fieldNames (H.PFieldPun _ n) = case n of-		H.Qual _ _ n' -> [n']-		H.UnQual _ n' -> [n']-		_ -> []-	fieldNames (H.PFieldWildcard _) = []-getDef _ = []---- | Make function declaration by location, name and function type-mkFun :: H.SrcSpanInfo -> H.Name H.SrcSpanInfo -> DeclarationInfo -> Declaration-mkFun loc n = setPosition loc . decl (identOfName n)---- | Make function from arguments and result------ @[a, b, c...] `tyFun` r == a `TyFun` b `TyFun` c ... `TyFun` r@-tyFun :: [H.Type H.SrcSpanInfo] -> H.Type H.SrcSpanInfo -> H.Type H.SrcSpanInfo-tyFun as' r' = foldr (H.TyFun H.noSrcSpan) r' as'---- | Get name of qualified name-identOfQName :: H.QName H.SrcSpanInfo -> (Maybe Text, Text)-identOfQName (H.Qual _ (H.ModuleName _ mname) name) = (Just $ fromString mname, identOfName name)-identOfQName (H.UnQual _ name) = (Nothing, identOfName name)-identOfQName (H.Special _ sname) = (Nothing, fromString $ H.prettyPrint sname)---- | Get name of @H.Name@-identOfName :: H.Name H.SrcSpanInfo -> Text-identOfName name = fromString $ case name of-	H.Ident _ s -> s-	H.Symbol _ s -> s---- | Print something in one line-oneLinePrint :: (H.Pretty a, IsString s) => a -> s-oneLinePrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode---- | Print something-prettyPrint :: (H.Pretty a, IsString s) => a -> s-prettyPrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.PageMode }) mode' where-	mode' = H.PPHsMode {-		H.classIndent = 4,-		H.doIndent = 4,-		H.multiIfIndent = 4,-		H.caseIndent = 4,-		H.letIndent = 4,-		H.whereIndent = 4,-		H.onsideIndent = 2,-		H.spacing = False,-		H.layout = H.PPOffsideRule,-		H.linePragmas = False }---- | Convert @H.SrcSpanInfo@ to @Position-toPosition :: H.SrcSpanInfo -> Position-toPosition s = Position (H.startLine s) (H.startColumn s)---- | Set @Declaration@ position-setPosition :: H.SrcSpanInfo -> Declaration -> Declaration-setPosition loc = set declarationPosition (Just $ toPosition loc)---- | Adds documentation to declaration-addDoc :: Map String String -> Declaration -> Declaration-addDoc docsMap decl' = set declarationDocs (preview (ix (view declarationName decl')) docsMap') decl' where-	docsMap' = M.mapKeys fromString . M.map fromString $ docsMap---- | Adds documentation to all declarations in module-addDocs :: Map String String -> Module -> Module-addDocs docsMap = over moduleDeclarations (map $ addDoc docsMap)---- | Extract files docs and set them to declarations-inspectDocsChunk :: [String] -> [Module] -> IO [Module]-inspectDocsChunk opts ms = hsdevLiftIOWith (ToolError "hdocs") $ do-	docsMaps <- hdocsy (map (view moduleLocation) ms) opts-	return $ zipWith addDocs docsMaps ms---- | Extract file docs and set them to module declarations-inspectDocs :: [String] -> Module -> IO Module-inspectDocs opts m = do-	let-		hdocsWorkaround = False-	docsMap <- hsdevLiftIOWith (ToolError "hdocs") $ if hdocsWorkaround-		then hdocsProcess (fromMaybe (T.unpack $ view moduleName m) (preview (moduleLocation . moduleFile) m)) opts-		else liftM Just $ hdocs (view moduleLocation m) opts-	return $ maybe id addDocs docsMap m---- | Like @inspectDocs@, but in @Ghc@ monad-inspectDocsGhc :: [String] -> Module -> Ghc Module-inspectDocsGhc opts m = case view moduleLocation m of-	FileModule fpath _ -> do-		docsMap <- liftM (fmap (formatDocs . snd) . listToMaybe) $ hsdevLift $ readSourcesGhc opts [fpath]-		return $ maybe id addDocs docsMap m-	_ -> hsdevError $ ModuleNotSource (view moduleLocation m)---- | Inspect contents-inspectContents :: String -> [(String, String)] -> [String] -> String -> ExceptT String IO InspectedModule-inspectContents name defines opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do-	cts' <- lift $ preprocess_ defines exts name cts-	analyzed <- ExceptT $ return $ analyzeModule exts (Just name) cts' <|> analyzeModule_ exts (Just name) cts'-	return $ set moduleLocation (ModuleSource $ Just name) analyzed-	where-		exts = mapMaybe flagExtension opts--contentsInspection :: String -> [String] -> ExceptT String IO Inspection-contentsInspection _ _ = return InspectionNone -- crc or smth---- | Inspect file-inspectFile :: [(String, String)] -> [String] -> FilePath -> Maybe String -> IO InspectedModule-inspectFile defines opts file mcts = hsdevLiftIO $ do-	proj <- locateProject file-	absFilename <- Dir.canonicalizePath file-	ex <- Dir.doesFileExist absFilename-	unless ex $ hsdevError $ FileNotFound absFilename-	inspect (FileModule absFilename proj) ((if isJust mcts then fileContentsInspection else fileInspection) absFilename opts) $ do-		-- docsMap <- liftE $ if hdocsWorkaround-		-- 	then hdocsProcess absFilename opts-		-- 	else liftM Just $ hdocs (FileModule absFilename Nothing) opts-		forced <- hsdevLiftWith InspectError $ ExceptT $ E.handle onError $ do-			analyzed <- liftM (\s -> analyzeModule exts (Just absFilename) s <|> analyzeModule_ exts (Just absFilename) s) $-				maybe (readFileUtf8 absFilename >>= preprocess_ defines exts file) return mcts-			force analyzed `deepseq` return analyzed-		-- return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced-		return $ set moduleLocation (FileModule absFilename proj) forced-	where-		onError :: E.ErrorCall -> IO (Either String Module)-		onError = return . Left . show--		exts = mapMaybe flagExtension opts---- | File inspection data-fileInspection :: FilePath -> [String] -> IO Inspection-fileInspection f opts = do-	tm <- Dir.getModificationTime f-	return $ InspectionAt (utcTimeToPOSIXSeconds tm) $ sort $ ordNub opts---- | File contents inspection data-fileContentsInspection :: FilePath -> [String] -> IO Inspection-fileContentsInspection _ opts = do-	tm <- getPOSIXTime-	return $ InspectionAt tm $ sort $ ordNub opts---- | Enumerate project dirs-projectDirs :: Project -> IO [Extensions FilePath]-projectDirs p = do-	p' <- loadProject p-	return $ ordNub $ map (fmap (normalise . (view projectPath p' </>))) $ maybe [] sourceDirs $ view projectDescription p'---- | Enumerate project source files-projectSources :: Project -> IO [Extensions FilePath]-projectSources p = do-	dirs <- projectDirs p-	let-		enumCabals = liftM (map takeDirectory . filter cabalFile) . traverseDirectory-		dirs' = map (view entity) dirs-	-- enum inner projects and dont consider them as part of this project-	subProjs <- liftM (delete (view projectPath p) . ordNub . concat) $ triesMap (enumCabals) dirs'-	let-		enumHs = liftM (filter thisProjectSource) . traverseDirectory-		thisProjectSource h = haskellSource h && not (any (`isParent` h) subProjs)-	liftM (ordNub . concat) $ triesMap (liftM sequenceA . traverse (enumHs)) dirs---- | Inspect project-inspectProject :: [(String, String)] -> [String] -> Project -> IO (Project, [InspectedModule])-inspectProject defines opts p = hsdevLiftIO $ do-	p' <- loadProject p-	srcs <- projectSources p'-	modules <- mapM inspectFile' srcs-	return (p', catMaybes modules)-	where-		inspectFile' exts = liftM return (inspectFile defines (opts ++ extensionsOpts exts) (view entity exts) Nothing) <|> return Nothing---- | Get actual defines-getDefines :: IO [(String, String)]-getDefines = E.handle onIO $ do-	tmp <- Dir.getTemporaryDirectory-	writeFile (tmp </> "defines.hs") ""-	_ <- runWait "ghc" ["-E", "-optP-dM", "-cpp", tmp </> "defines.hs"] ""-	cts <- readFileUtf8 (tmp </> "defines.hspp")-	Dir.removeFile (tmp </> "defines.hs")-	Dir.removeFile (tmp </> "defines.hspp")-	return $ mapMaybe (\g -> (,) <$> g 1 <*> g 2) $ mapMaybe (matchRx rx) $ lines cts-	where-		rx = "#define ([^\\s]+) (.*)"-		onIO :: E.IOException -> IO [(String, String)]-		onIO _ = return []--preprocess :: [(String, String)] -> FilePath -> String -> IO String-preprocess defines fpath cts = do-	cts' <- E.catch (Cpphs.cppIfdef fpath defines [] Cpphs.defaultBoolOptions cts) onIOError-	return $ unlines $ map snd cts'-	where-		onIOError :: E.IOException -> IO [(Cpphs.Posn, String)]-		onIOError _ = return []--preprocess_ :: [(String, String)] -> [String] -> FilePath -> String -> IO String-preprocess_ defines exts fpath cts-	| hasCPP = preprocess defines fpath cts-	| otherwise = return cts-	where-		exts' = map H.parseExtension exts ++ maybe [] snd (H.readExtensions cts)-		hasCPP = H.EnableExtension H.CPP `elem` exts'+{-# LANGUAGE TypeSynonymInstances #-}
+
+module HsDev.Inspect (
+	analyzeModule, inspectDocsChunk, inspectDocs, inspectDocsGhc,
+	inspectContents, contentsInspection,
+	inspectFile, fileInspection,
+	projectDirs, projectSources,
+	inspectProject,
+	getDefines,
+	preprocess, preprocess_,
+
+	module Control.Monad.Except
+	) where
+
+import Control.Arrow
+import Control.Applicative
+import Control.DeepSeq
+import qualified Control.Exception as E
+import Control.Lens (view, preview, set, over)
+import Control.Lens.At (ix)
+import Control.Monad
+import Control.Monad.Except
+import Data.Char (isSpace)
+import Data.Function (on)
+import Data.List
+import Data.Map (Map)
+import Data.Maybe (fromMaybe, mapMaybe, catMaybes, listToMaybe, isJust)
+import Data.Ord (comparing)
+import Data.String (IsString, fromString)
+import Data.Text (Text)
+import qualified Data.Text as T (unpack)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, getPOSIXTime)
+import qualified Data.Map as M
+import qualified Language.Haskell.Exts as H
+import qualified Language.Preprocessor.Cpphs as Cpphs
+import qualified System.Directory as Dir
+import System.FilePath
+import Data.Generics.Uniplate.Data
+import HDocs.Haddock
+
+import HsDev.Error
+import HsDev.Symbols
+import HsDev.Tools.Base
+import HsDev.Tools.Ghc.Worker ()
+import HsDev.Tools.HDocs (hdocsy, hdocs, hdocsProcess)
+import HsDev.Util
+
+-- | Analize source contents
+analyzeModule :: [String] -> Maybe FilePath -> String -> Either String Module
+analyzeModule exts file source = case H.parseFileContentsWithMode (parseMode file exts) source' of
+	H.ParseFailed loc reason -> Left $ "Parse failed at " ++ show loc ++ ": " ++ reason
+	H.ParseOk (H.Module _ (Just (H.ModuleHead _ (H.ModuleName _ mname) _ mexports)) _ imports declarations) -> Right Module {
+		_moduleName = fromString mname,
+		_moduleDocs =  Nothing,
+		_moduleLocation = ModuleSource Nothing,
+		_moduleExports = fmap (concatMap getExports . getSpec) mexports,
+		_moduleImports = map getImport imports,
+		_moduleDeclarations = sortDeclarations $ getDecls declarations }
+	_ -> Left "Unknown module"
+	where
+		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces
+		source' = map untab source
+		untab '\t' = ' '
+		untab ch = ch
+		getSpec (H.ExportSpecList _ es) = es
+
+-- | Analize source contents
+analyzeModule_ :: [String] -> Maybe FilePath -> String -> Either String Module
+analyzeModule_ exts file source = do
+	mname <- parseModuleName source'
+	return Module {
+		_moduleName = fromString mname,
+		_moduleDocs = Nothing,
+		_moduleLocation = ModuleSource Nothing,
+		_moduleExports = do
+			H.PragmasAndModuleHead _ _ mhead <- parseModuleHead' source'
+			H.ModuleHead _ _ _ mexports <- mhead
+			H.ExportSpecList _ exports <- mexports
+			return $ concatMap getExports exports,
+		_moduleImports = map getImport $ mapMaybe (uncurry parseImport') parts,
+		_moduleDeclarations = sortDeclarations $ getDecls $ mapMaybe (uncurry parseDecl') parts }
+	where
+		parts :: [(Int, String)]
+		parts = zip offsets (map unlines parts') where
+			parts' :: [[String]]
+			parts' = unfoldr break' $ lines source'
+			offsets = scanl (+) 0 $ map length parts'
+		break' :: [String] -> Maybe ([String], [String])
+		break' [] = Nothing
+		break' (l:ls) = Just $ first (l:) $ span (maybe True isSpace . listToMaybe) ls
+
+		parseModuleName :: String -> Either String String
+		parseModuleName cts = maybe (Left "match fail") Right $ do
+			g <- matchRx "^module\\s+([\\w\\.]+)" cts
+			g 1
+
+		parseDecl' :: Int -> String -> Maybe (H.Decl H.SrcSpanInfo)
+		parseDecl' offset cts = maybeResult $ fmap (transformBi $ addOffset offset) $
+			H.parseDeclWithMode (parseMode file exts) cts
+
+		parseImport' :: Int -> String -> Maybe (H.ImportDecl H.SrcSpanInfo)
+		parseImport' offset cts = maybeResult $ fmap (transformBi $ addOffset offset) $
+			H.parseImportDeclWithMode (parseMode file exts) cts
+
+		parseModuleHead' :: String -> Maybe (H.PragmasAndModuleHead H.SrcSpanInfo)
+		parseModuleHead' = maybeResult . fmap H.unNonGreedy . H.parseWithMode (parseMode file exts)
+
+		maybeResult :: H.ParseResult a -> Maybe a
+		maybeResult (H.ParseFailed _ _) = Nothing
+		maybeResult (H.ParseOk r) = Just r
+
+		addOffset :: Int -> H.SrcSpan -> H.SrcSpan
+		addOffset offset src = src { H.srcSpanStartLine = H.srcSpanStartLine src + offset, H.srcSpanEndLine = H.srcSpanEndLine src + offset }
+
+		-- Replace all tabs to spaces to make SrcLoc valid, otherwise it treats tab as 8 spaces
+		source' = map untab source
+		untab '\t' = ' '
+		untab ch = ch
+
+parseMode :: Maybe FilePath -> [String] -> H.ParseMode
+parseMode file exts = H.defaultParseMode {
+	H.parseFilename = fromMaybe (H.parseFilename H.defaultParseMode) file,
+	H.baseLanguage = H.Haskell2010,
+	H.extensions = H.glasgowExts ++ map H.parseExtension exts,
+	H.fixities = Just H.baseFixities }
+
+-- | Get exports
+getExports :: H.ExportSpec H.SrcSpanInfo -> [Export]
+getExports (H.EModuleContents _ (H.ModuleName _ m)) = [ExportModule $ fromString m]
+getExports (H.EVar _ n) = [uncurry ExportName (identOfQName n) ThingNothing]
+getExports (H.EAbs _ _ n) = [uncurry ExportName (identOfQName n) ThingNothing]
+getExports (H.EThingWith _ _ n ns) = [uncurry ExportName (identOfQName n) $ ThingWith (map toStr ns)] where
+	toStr :: H.CName H.SrcSpanInfo -> Text
+	toStr (H.VarName _ cn) = identOfName cn
+	toStr (H.ConName _ cn) = identOfName cn
+
+-- | Get import
+getImport :: H.ImportDecl H.SrcSpanInfo -> Import
+getImport d = Import
+	(mname (H.importModule d))
+	(H.importQualified d)
+	(mname <$> H.importAs d)
+	(importLst <$> H.importSpecs d)
+	(Just $ toPosition $ H.ann d)
+	where
+		mname (H.ModuleName _ n) = fromString n
+		importLst (H.ImportSpecList _ hiding specs) = ImportList hiding $ map impSpec specs
+		impSpec (H.IVar _ n) = ImportSpec (identOfName n) ThingNothing
+		impSpec (H.IAbs _ _ n) = ImportSpec (identOfName n) ThingNothing
+		impSpec (H.IThingAll _ n) = ImportSpec (identOfName n) ThingAll
+		impSpec (H.IThingWith _ n ns) = ImportSpec (identOfName n) $ ThingWith $ map identOfName (concatMap childrenBi ns :: [H.Name H.SrcSpanInfo])
+
+-- | Decl declarations
+getDecls :: [H.Decl H.SrcSpanInfo] -> [Declaration]
+getDecls decls =
+	map mergeDecls .
+	groupBy ((==) `on` view declarationName) .
+	sortBy (comparing (view declarationName)) $
+	concatMap getDecl decls ++ concatMap getDef decls
+	where
+		mergeDecls :: [Declaration] -> Declaration
+		mergeDecls [] = error "Impossible"
+		mergeDecls ds = Declaration
+			(view declarationName $ head ds)
+			Nothing
+			Nothing
+			(msum $ map (view declarationDocs) ds)
+			(minimum <$> mapM (view declarationPosition) ds)
+			(foldr1 mergeInfos $ map (view declaration) ds)
+
+		mergeInfos :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
+		mergeInfos (Function ln ld lr) (Function rn rd rr) = Function (ln `mplus` rn) (ld ++ rd) (lr `mplus` rr)
+		mergeInfos l _ = l
+
+-- | Get local binds
+getLocalDecls :: H.Decl H.SrcSpanInfo -> [Declaration]
+getLocalDecls decl' = concatMap getDecls' binds' where
+	binds' :: [H.Binds H.SrcSpanInfo]
+	binds' = universeBi decl'
+	getDecls' :: H.Binds H.SrcSpanInfo -> [Declaration]
+	getDecls' (H.BDecls _ decls) = getDecls decls
+	getDecls' _ = []
+
+-- | Get declaration and child declarations
+getDecl :: H.Decl H.SrcSpanInfo -> [Declaration]
+getDecl decl' = case decl' of
+	H.TypeSig loc names typeSignature -> [mkFun loc n (Function (Just $ oneLinePrint typeSignature) [] Nothing) | n <- names]
+	H.TypeDecl loc h _ -> [mkType loc (tyName h) Type (tyArgs h) `withDef` decl']
+	H.DataDecl loc dataOrNew mctx h cons _ -> (mkType loc (tyName h) (ctor dataOrNew `withCtx` mctx) (tyArgs h) `withDef` decl') : concatMap (map (addRel $ tyName h) . getConDecl (tyName h) (tyArgs h)) cons
+	H.GDataDecl loc dataOrNew mctx h _ gcons _ -> (mkType loc (tyName h) (ctor dataOrNew `withCtx` mctx) (tyArgs h) `withDef` decl') : concatMap (map (addRel $ tyName h) . getGConDecl) gcons
+	H.ClassDecl loc ctx h _ _ -> [mkType loc (tyName h) (Class `withCtx` ctx) (tyArgs h) `withDef` decl']
+	_ -> []
+	where
+		mkType :: H.SrcSpanInfo -> H.Name H.SrcSpanInfo -> (TypeInfo -> DeclarationInfo) -> [H.TyVarBind H.SrcSpanInfo] -> Declaration
+		mkType loc n ctor' args = setPosition loc $ decl (identOfName n) $ ctor' $ TypeInfo Nothing (map oneLinePrint args) Nothing []
+
+		withDef :: H.Pretty a => Declaration -> a -> Declaration
+		withDef tyDecl' tyDef = set (declaration . typeInfo . typeInfoDefinition) (Just $ prettyPrint tyDef) tyDecl'
+
+		withCtx :: (TypeInfo -> DeclarationInfo) -> Maybe (H.Context H.SrcSpanInfo) -> TypeInfo -> DeclarationInfo
+		withCtx ctor' mctx = ctor' . set typeInfoContext (fmap makeCtx mctx)
+
+		ctor :: H.DataOrNew H.SrcSpanInfo -> TypeInfo -> DeclarationInfo
+		ctor (H.DataType _) = Data
+		ctor (H.NewType _) = NewType
+
+		makeCtx ctx = fromString $ oneLinePrint ctx
+
+		addRel :: H.Name H.SrcSpanInfo -> Declaration -> Declaration
+		addRel n = set (declaration . related) (Just $ identOfName n)
+
+		tyName :: H.DeclHead H.SrcSpanInfo -> H.Name H.SrcSpanInfo
+		tyName (H.DHead _ n) = n
+		tyName (H.DHInfix _ _ n) = n
+		tyName (H.DHParen _ h) = tyName h
+		tyName (H.DHApp _ h _) = tyName h
+
+		tyArgs :: H.DeclHead H.SrcSpanInfo -> [H.TyVarBind H.SrcSpanInfo]
+		tyArgs = universeBi
+
+-- | Get constructor and record fields declarations
+getConDecl :: H.Name H.SrcSpanInfo -> [H.TyVarBind H.SrcSpanInfo] -> H.QualConDecl H.SrcSpanInfo -> [Declaration]
+getConDecl t as (H.QualConDecl loc _ _ cdecl) = case cdecl of
+	H.ConDecl _ n cts -> [mkFun loc n (Function (Just $ oneLinePrint $ cts `tyFun` dataRes) [] Nothing)]
+	H.InfixConDecl _ ct n cts -> [mkFun loc n (Function (Just $ oneLinePrint $ (ct : [cts]) `tyFun` dataRes) [] Nothing)]
+	H.RecDecl _ n fields -> mkFun loc n (Function (Just $ oneLinePrint $ map tyField fields `tyFun` dataRes) [] Nothing) : concatMap (getRec loc dataRes) fields
+	where
+		dataRes :: H.Type H.SrcSpanInfo
+		dataRes = foldr (H.TyApp loc . H.TyVar loc . nameOf) (H.TyCon loc (H.UnQual loc t)) as where
+			nameOf :: H.TyVarBind H.SrcSpanInfo -> H.Name H.SrcSpanInfo
+			nameOf (H.KindedVar _ n' _) = n'
+			nameOf (H.UnkindedVar _ n') = n'
+
+tyField :: H.FieldDecl H.SrcSpanInfo -> H.Type H.SrcSpanInfo
+tyField (H.FieldDecl _ _ t) = t
+
+-- | Get GADT constructor and record fields declarations
+getGConDecl :: H.GadtDecl H.SrcSpanInfo -> [Declaration]
+getGConDecl (H.GadtDecl loc n mfields r) = mkFun loc n (Function (Just $ oneLinePrint $ map tyField (fromMaybe [] mfields) `tyFun` r) [] Nothing) : concatMap (getRec loc r) (fromMaybe [] mfields)
+
+-- | Get record field declaration
+getRec :: H.SrcSpanInfo -> H.Type H.SrcSpanInfo -> H.FieldDecl H.SrcSpanInfo -> [Declaration]
+getRec loc t (H.FieldDecl _ ns rt) = [mkFun loc n (Function (Just $ oneLinePrint $ H.TyFun loc t rt) [] Nothing) | n <- ns]
+
+-- | Get definitions
+getDef :: H.Decl H.SrcSpanInfo -> [Declaration]
+getDef (H.FunBind _ []) = []
+getDef d@(H.FunBind _ (m : _)) = [setPosition (H.ann m) $ decl (identOfName $ identOfMatch m) fun] where
+	identOfMatch (H.Match _ n _ _ _) = n
+	identOfMatch (H.InfixMatch _ _ n _ _ _) = n
+	fun = Function Nothing (getLocalDecls d) Nothing
+getDef d@(H.PatBind loc pat _ _) = map (\name -> setPosition loc (decl (identOfName name) (Function Nothing (getLocalDecls d) Nothing))) (names pat) where
+	names :: H.Pat H.SrcSpanInfo -> [H.Name H.SrcSpanInfo]
+	names (H.PVar _ n) = [n]
+	names (H.PNPlusK _ n _) = [n]
+	names (H.PInfixApp _ l _ r) = names l ++ names r
+	names (H.PApp _ _ ns) = concatMap names ns
+	names (H.PTuple _ _ ns) = concatMap names ns
+	names (H.PList _ ns) = concatMap names ns
+	names (H.PParen _ n) = names n
+	names (H.PRec _ _ pf) = concatMap fieldNames pf
+	names (H.PAsPat _ n ns) = n : names ns
+	names (H.PWildCard _) = []
+	names (H.PIrrPat _ n) = names n
+	names (H.PatTypeSig _ n _) = names n
+	names (H.PViewPat _ _ n) = names n
+	names (H.PBangPat _ n) = names n
+	names _ = []
+
+	fieldNames :: H.PatField H.SrcSpanInfo -> [H.Name H.SrcSpanInfo]
+	fieldNames (H.PFieldPat _ _ n) = names n
+	fieldNames (H.PFieldPun _ n) = case n of
+		H.Qual _ _ n' -> [n']
+		H.UnQual _ n' -> [n']
+		_ -> []
+	fieldNames (H.PFieldWildcard _) = []
+getDef _ = []
+
+-- | Make function declaration by location, name and function type
+mkFun :: H.SrcSpanInfo -> H.Name H.SrcSpanInfo -> DeclarationInfo -> Declaration
+mkFun loc n = setPosition loc . decl (identOfName n)
+
+-- | Make function from arguments and result
+--
+-- @[a, b, c...] `tyFun` r == a `TyFun` b `TyFun` c ... `TyFun` r@
+tyFun :: [H.Type H.SrcSpanInfo] -> H.Type H.SrcSpanInfo -> H.Type H.SrcSpanInfo
+tyFun as' r' = foldr (H.TyFun H.noSrcSpan) r' as'
+
+-- | Get name of qualified name
+identOfQName :: H.QName H.SrcSpanInfo -> (Maybe Text, Text)
+identOfQName (H.Qual _ (H.ModuleName _ mname) name) = (Just $ fromString mname, identOfName name)
+identOfQName (H.UnQual _ name) = (Nothing, identOfName name)
+identOfQName (H.Special _ sname) = (Nothing, fromString $ H.prettyPrint sname)
+
+-- | Get name of @H.Name@
+identOfName :: H.Name H.SrcSpanInfo -> Text
+identOfName name = fromString $ case name of
+	H.Ident _ s -> s
+	H.Symbol _ s -> s
+
+-- | Print something in one line
+oneLinePrint :: (H.Pretty a, IsString s) => a -> s
+oneLinePrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.OneLineMode }) H.defaultMode
+
+-- | Print something
+prettyPrint :: (H.Pretty a, IsString s) => a -> s
+prettyPrint = fromString . H.prettyPrintStyleMode (H.style { H.mode = H.PageMode }) mode' where
+	mode' = H.PPHsMode {
+		H.classIndent = 4,
+		H.doIndent = 4,
+		H.multiIfIndent = 4,
+		H.caseIndent = 4,
+		H.letIndent = 4,
+		H.whereIndent = 4,
+		H.onsideIndent = 2,
+		H.spacing = False,
+		H.layout = H.PPOffsideRule,
+		H.linePragmas = False }
+
+-- | Convert @H.SrcSpanInfo@ to @Position
+toPosition :: H.SrcSpanInfo -> Position
+toPosition s = Position (H.startLine s) (H.startColumn s)
+
+-- | Set @Declaration@ position
+setPosition :: H.SrcSpanInfo -> Declaration -> Declaration
+setPosition loc = set declarationPosition (Just $ toPosition loc)
+
+-- | Adds documentation to declaration
+addDoc :: Map String String -> Declaration -> Declaration
+addDoc docsMap decl' = set declarationDocs (preview (ix (view declarationName decl')) docsMap') decl' where
+	docsMap' = M.mapKeys fromString . M.map fromString $ docsMap
+
+-- | Adds documentation to all declarations in module
+addDocs :: Map String String -> Module -> Module
+addDocs docsMap = over moduleDeclarations (map $ addDoc docsMap)
+
+-- | Extract files docs and set them to declarations
+inspectDocsChunk :: [String] -> [Module] -> IO [Module]
+inspectDocsChunk opts ms = hsdevLiftIOWith (ToolError "hdocs") $ do
+	docsMaps <- hdocsy (map (view moduleLocation) ms) opts
+	return $ zipWith addDocs docsMaps ms
+
+-- | Extract file docs and set them to module declarations
+inspectDocs :: [String] -> Module -> IO Module
+inspectDocs opts m = do
+	let
+		hdocsWorkaround = False
+	docsMap <- if hdocsWorkaround
+		then hdocsProcess (fromMaybe (T.unpack $ view moduleName m) (preview (moduleLocation . moduleFile) m)) opts
+		else liftM Just $ hdocs (view moduleLocation m) opts
+	return $ maybe id addDocs docsMap m
+
+-- | Like @inspectDocs@, but in @Ghc@ monad
+inspectDocsGhc :: [String] -> Module -> Ghc Module
+inspectDocsGhc opts m = case view moduleLocation m of
+	FileModule fpath _ -> do
+		docsMap <- liftM (fmap (formatDocs . snd) . listToMaybe) $ hsdevLift $ readSourcesGhc opts [fpath]
+		return $ maybe id addDocs docsMap m
+	_ -> hsdevError $ ModuleNotSource (view moduleLocation m)
+
+-- | Inspect contents
+inspectContents :: String -> [(String, String)] -> [String] -> String -> ExceptT String IO InspectedModule
+inspectContents name defines opts cts = inspect (ModuleSource $ Just name) (contentsInspection cts opts) $ do
+	cts' <- lift $ preprocess_ defines exts name cts
+	analyzed <- ExceptT $ return $ analyzeModule exts (Just name) cts' <|> analyzeModule_ exts (Just name) cts'
+	return $ set moduleLocation (ModuleSource $ Just name) analyzed
+	where
+		exts = mapMaybe flagExtension opts
+
+contentsInspection :: String -> [String] -> ExceptT String IO Inspection
+contentsInspection _ _ = return InspectionNone -- crc or smth
+
+-- | Inspect file
+inspectFile :: [(String, String)] -> [String] -> FilePath -> Maybe String -> IO InspectedModule
+inspectFile defines opts file mcts = hsdevLiftIO $ do
+	proj <- locateProject file
+	absFilename <- Dir.canonicalizePath file
+	ex <- Dir.doesFileExist absFilename
+	unless ex $ hsdevError $ FileNotFound absFilename
+	inspect (FileModule absFilename proj) ((if isJust mcts then fileContentsInspection else fileInspection) absFilename opts) $ do
+		-- docsMap <- liftE $ if hdocsWorkaround
+		-- 	then hdocsProcess absFilename opts
+		-- 	else liftM Just $ hdocs (FileModule absFilename Nothing) opts
+		forced <- hsdevLiftWith InspectError $ ExceptT $ E.handle onError $ do
+			analyzed <- liftM (\s -> analyzeModule exts (Just absFilename) s <|> analyzeModule_ exts (Just absFilename) s) $
+				maybe (readFileUtf8 absFilename >>= preprocess_ defines exts file) return mcts
+			force analyzed `deepseq` return analyzed
+		-- return $ setLoc absFilename proj . maybe id addDocs docsMap $ forced
+		return $ set moduleLocation (FileModule absFilename proj) forced
+	where
+		onError :: E.ErrorCall -> IO (Either String Module)
+		onError = return . Left . show
+
+		exts = mapMaybe flagExtension opts
+
+-- | File inspection data
+fileInspection :: FilePath -> [String] -> IO Inspection
+fileInspection f opts = do
+	tm <- Dir.getModificationTime f
+	return $ InspectionAt (utcTimeToPOSIXSeconds tm) $ sort $ ordNub opts
+
+-- | File contents inspection data
+fileContentsInspection :: FilePath -> [String] -> IO Inspection
+fileContentsInspection _ opts = do
+	tm <- getPOSIXTime
+	return $ InspectionAt tm $ sort $ ordNub opts
+
+-- | Enumerate project dirs
+projectDirs :: Project -> IO [Extensions FilePath]
+projectDirs p = do
+	p' <- loadProject p
+	return $ ordNub $ map (fmap (normalise . (view projectPath p' </>))) $ maybe [] sourceDirs $ view projectDescription p'
+
+-- | Enumerate project source files
+projectSources :: Project -> IO [Extensions FilePath]
+projectSources p = do
+	dirs <- projectDirs p
+	let
+		enumCabals = liftM (map takeDirectory . filter cabalFile) . traverseDirectory
+		dirs' = map (view entity) dirs
+	-- enum inner projects and dont consider them as part of this project
+	subProjs <- liftM (delete (view projectPath p) . ordNub . concat) $ triesMap (enumCabals) dirs'
+	let
+		enumHs = liftM (filter thisProjectSource) . traverseDirectory
+		thisProjectSource h = haskellSource h && not (any (`isParent` h) subProjs)
+	liftM (ordNub . concat) $ triesMap (liftM sequenceA . traverse (enumHs)) dirs
+
+-- | Inspect project
+inspectProject :: [(String, String)] -> [String] -> Project -> IO (Project, [InspectedModule])
+inspectProject defines opts p = hsdevLiftIO $ do
+	p' <- loadProject p
+	srcs <- projectSources p'
+	modules <- mapM inspectFile' srcs
+	return (p', catMaybes modules)
+	where
+		inspectFile' exts = liftM return (inspectFile defines (opts ++ extensionsOpts exts) (view entity exts) Nothing) <|> return Nothing
+
+-- | Get actual defines
+getDefines :: IO [(String, String)]
+getDefines = E.handle onIO $ do
+	tmp <- Dir.getTemporaryDirectory
+	writeFile (tmp </> "defines.hs") ""
+	_ <- runWait "ghc" ["-E", "-optP-dM", "-cpp", tmp </> "defines.hs"] ""
+	cts <- readFileUtf8 (tmp </> "defines.hspp")
+	Dir.removeFile (tmp </> "defines.hs")
+	Dir.removeFile (tmp </> "defines.hspp")
+	return $ mapMaybe (\g -> (,) <$> g 1 <*> g 2) $ mapMaybe (matchRx rx) $ lines cts
+	where
+		rx = "#define ([^\\s]+) (.*)"
+		onIO :: E.IOException -> IO [(String, String)]
+		onIO _ = return []
+
+preprocess :: [(String, String)] -> FilePath -> String -> IO String
+preprocess defines fpath cts = do
+	cts' <- E.catch (Cpphs.cppIfdef fpath defines [] Cpphs.defaultBoolOptions cts) onIOError
+	return $ unlines $ map snd cts'
+	where
+		onIOError :: E.IOException -> IO [(Cpphs.Posn, String)]
+		onIOError _ = return []
+
+preprocess_ :: [(String, String)] -> [String] -> FilePath -> String -> IO String
+preprocess_ defines exts fpath cts
+	| hasCPP = preprocess defines fpath cts
+	| otherwise = return cts
+	where
+		exts' = map H.parseExtension exts ++ maybe [] snd (H.readExtensions cts)
+		hasCPP = H.EnableExtension H.CPP `elem` exts'

src/HsDev/Project.hs view

@@ -4,7 +4,7 @@ 	infoSourceDirsDef,
 	readProject, loadProject,
 	withExtensions,
-	infos, inTarget, fileTargets, findSourceDir, sourceDirs,
+	infos, inTarget, fileTarget, fileTargets, findSourceDir, sourceDirs,
 	targetOpts,
 
 	-- * Helpers
@@ -112,7 +112,11 @@ 
 -- | Check if source related to target, source must be relative to project directory
 inTarget :: FilePath -> Info -> Bool
-inTarget src info = any ((`isPrefixOf` normalise src) . normalise) $ view infoSourceDirsDef info
+inTarget src info = any (`isParent` src) $ view infoSourceDirsDef info
+
+-- | Get first target for source file
+fileTarget :: Project -> FilePath -> Maybe Info
+fileTarget p f = listToMaybe $ fileTargets p f
 
 -- | Get possible targets for source file
 -- There can be many candidates in case of module related to several executables or tests

src/HsDev/Sandbox.hs view

@@ -19,6 +19,7 @@ import Data.Aeson
 import Data.Maybe (isJust, fromMaybe)
 import Data.List ((\\))
+import Data.String (fromString)
 import qualified Data.Text as T (unpack)
 import Distribution.Compiler
 import Distribution.System
@@ -26,6 +27,7 @@ import System.FilePath
 import System.Directory
 import System.Log.Simple (MonadLog(..))
+import qualified System.Log.Simple as Log
 
 import System.Directory.Paths
 import HsDev.PackageDb
@@ -34,7 +36,7 @@ import HsDev.Symbols (moduleOpts)
 import HsDev.Symbols.Types (Module(..), ModuleLocation(..), moduleLocation)
 import HsDev.Tools.Ghc.Compat as Compat
-import HsDev.Util (searchPath)
+import HsDev.Util (searchPath, directoryContents)
 
 import qualified Packages as GHC
 
@@ -83,7 +85,7 @@ 	isDir <- doesDirectoryExist fpath'
 	if isDir
 		then do
-			dirs <- liftM ((fpath' :) . map (fpath' </>) . (\\ [".", ".."])) $ getDirectoryContents fpath'
+			dirs <- liftM (fpath' :) $ directoryContents fpath'
 			return $ msum $ map sandboxFromDir dirs
 		else return Nothing
 	where
@@ -141,7 +143,7 @@ getModuleOpts :: MonadLog m => [String] -> Module -> m [String]
 getModuleOpts opts m = do
 	pdbs <- case view moduleLocation m of
-		FileModule fpath _ -> searchPackageDbStack fpath
+		FileModule fpath p -> searchPackageDbStack fpath
 		InstalledModule pdb _ _ -> restorePackageDbStack pdb
 		ModuleSource _ -> return userDb
 	pkgs <- browsePackages opts pdbs

src/HsDev/Server/Commands.hs view

@@ -45,6 +45,7 @@ import qualified HsDev.Database.Async as DB
 import HsDev.Server.Base
 import HsDev.Server.Types
+import HsDev.Tools.Base (runTool_)
 import HsDev.Error
 import HsDev.Util
 import HsDev.Version
@@ -54,7 +55,6 @@ import Data.Char
 import Data.List
 import System.Environment
-import System.Process
 import System.Win32.FileMapping.Memory (withMapFile, readMapFile)
 import System.Win32.FileMapping.NamePool
 import System.Win32.PowerShell (escape, quote, quoteDouble)
@@ -123,9 +123,9 @@ 			~~ ("process" %= escape quote myExe)
 			~~ ("args" %= intercalate ", " (map biescape args))
 			~~ ("dir" %= escape quote curDir)
-	r <- readProcess "powershell" [
+	r <- runTool_ "powershell" [
 		"-Command",
-		script] ""
+		script]
 	if all isSpace r
 		then putStrLn $ "Server started at port {}" ~~ serverPort sopts
 		else mapM_ putStrLn [
@@ -167,11 +167,11 @@ 				bind s (sockAddr (serverPort sopts) addr')
 				listen s maxListenQueue
 			forever $ logAsync (Log.log Log.Fatal . fromString) $ logIO "exception: " (Log.log Log.Error . fromString) $ do
-				Log.log Log.Trace "accepting connection"
+				Log.log Log.Trace "accepting connection..."
 				liftIO $ signalQSem q
-				s' <- liftIO $ fst <$> accept s
-				Log.log Log.Trace $ "accepted {}" ~~ show s'
-				void $ liftIO $ forkIO $ withSession session $ Log.scope (T.pack $ show s') $
+				(s', addr') <- liftIO $ accept s
+				Log.log Log.Trace $ "accepted {}" ~~ show addr'
+				void $ liftIO $ forkIO $ withSession session $ Log.scope (T.pack $ show addr') $
 					logAsync (Log.log Log.Fatal . fromString) $ logIO "exception: " (Log.log Log.Error . fromString) $
 						flip finally (liftIO $ close s') $
 							bracket (liftIO newEmptyMVar) (liftIO . (`putMVar` ())) $ \done -> do
@@ -180,23 +180,23 @@ 									timeoutWait = withSession session $ do
 										notDone <- liftIO $ isEmptyMVar done
 										when notDone $ do
-											Log.log Log.Trace $ "waiting for {} to complete" ~~ show s'
+											Log.log Log.Trace $ "waiting for {} to complete" ~~ show addr'
 											waitAsync <- liftIO $ async $ do
 												threadDelay 1000000
 												killThread me
 											liftIO $ void $ waitCatch waitAsync
 								liftIO $ F.putChan clientChan timeoutWait
-								processClientSocket s'
+								processClientSocket (show addr') s'
 
-	Log.log Log.Trace "waiting for starting accept thread"
+	Log.log Log.Trace "waiting for starting accept thread..."
 	liftIO $ waitQSem q
 	Log.log Log.Info $ "Server started at port {}" ~~ serverPort sopts
-	Log.log Log.Trace "waiting for accept thread"
+	Log.log Log.Trace "waiting for accept thread..."
 	serverWait
 	Log.log Log.Trace "accept thread stopped"
 	liftIO $ unlink (serverPort sopts)
 	askSession sessionDatabase >>= liftIO . DB.readAsync >>= writeCache sopts
-	Log.log Log.Trace "waiting for clients"
+	Log.log Log.Trace "waiting for clients..."
 	liftIO (F.stopChan clientChan) >>= sequence_
 	Log.log Log.Info "server stopped"
 runServerCommand (Stop copts) = runServerCommand (Remote copts False Exit)
@@ -290,7 +290,7 @@ -- | Process client, listen for requests and process them
 processClient :: SessionMonad m => String -> F.Chan ByteString -> (ByteString -> IO ()) -> m ()
 processClient name rchan send' = do
-	Log.log Log.Info $ "{} connected" ~~ name
+	Log.log Log.Info "connected"
 	respChan <- liftIO newChan
 	liftIO $ void $ forkIO $ getChanContents respChan >>= mapM_ (send' . encodeMessage)
 	linkVar <- liftIO $ newMVar $ return ()
@@ -300,7 +300,7 @@ 		answer :: SessionMonad m => Msg (Message Response) -> m ()
 		answer m = do
 			unless (isNotification $ view (msg . message) m) $
-				Log.log Log.Trace $ " << {}" ~~ ellipsis (fromUtf8 (encode $ view (msg . message) m))
+				Log.log Log.Trace $ "responsed << {}" ~~ ellipsis (fromUtf8 (encode $ view (msg . message) m))
 			liftIO $ writeChan respChan m
 			where
 				ellipsis :: String -> String
@@ -309,21 +309,21 @@ 					| otherwise = take 100 str ++ "..."
 	-- flip finally (disconnected linkVar) $ forever $ Log.scopeLog (commandLogger copts) (T.pack name) $ do
 	reqs <- liftIO $ F.readChan rchan
-	flip finally (disconnected linkVar) $ Log.scope (T.pack name) $
+	flip finally (disconnected linkVar) $
 		forM_ reqs $ \req' -> do
-			Log.log Log.Trace $ " => {}" ~~ fromUtf8 req'
+			Log.log Log.Trace $ "received >> {}" ~~ fromUtf8 req'
 			case decodeMessage req' of
 				Left em -> do
 					Log.log Log.Warning $ "Invalid request {}" ~~ fromUtf8 req'
 					answer $ set msg (Message Nothing $ responseError $ RequestError "invalid request" $ fromUtf8 req') em
-				Right m -> void $ liftIO $ forkIO $ withSession s $
+				Right m -> void $ liftIO $ forkIO $ withSession s $ Log.scope (T.pack name) $ Log.scope "req" $
 					Log.scope (T.pack $ fromMaybe "_" (view (msg . messageId) m)) $ do
 						resp' <- flip (traverseOf (msg . message)) m $ \(Request c cdir noFile tm silent) -> do
 							let
 								onNotify n
 									| silent = return ()
 									| otherwise = traverseOf (msg . message) (const $ mmap' noFile (Response $ Left n)) m >>= answer
-							Log.log Log.Trace $ "{} >> {}" ~~ name ~~ fromUtf8 (encode c)
+							Log.log Log.Trace $ "requested >> {}" ~~ fromUtf8 (encode c)
 							resp <- liftIO $ fmap (Response . Right) $ handleTimeout tm $ hsdevLiftIO $ withSession s $
 								processRequest
 									CommandOptions {
@@ -352,17 +352,17 @@ 		-- Call on disconnected, either no action or exit command
 		disconnected :: SessionMonad m => MVar (IO ()) -> m ()
 		disconnected var = do
-			Log.log Log.Info $ "{} disconnected" ~~ name
+			Log.log Log.Info "disconnected"
 			liftIO $ join $ takeMVar var
 
 -- | Process client by socket
-processClientSocket :: SessionMonad m => Socket -> m ()
-processClientSocket s = do
+processClientSocket :: SessionMonad m => String -> Socket -> m ()
+processClientSocket name s = do
 	recvChan <- liftIO F.newChan
 	liftIO $ void $ forkIO $ finally
 		(Net.getContents s >>= mapM_ (F.putChan recvChan) . L.lines)
 		(F.closeChan recvChan)
-	processClient (show s) recvChan (sendLine s)
+	processClient name recvChan (sendLine s)
 	where
 		-- NOTE: Network version of `sendAll` goes to infinite loop on client socket close
 		-- when server's send is blocked, see https://github.com/haskell/network/issues/155

src/HsDev/Stack.hs view

@@ -38,6 +38,7 @@ import qualified HsDev.Tools.Ghc.Compat as Compat
 import HsDev.Scan.Browse (withPackages)
 import HsDev.Util as Util
+import HsDev.Tools.Base (runTool_)
 
 -- | Get compiler version
 stackCompiler :: MonadLog m => m String
@@ -64,7 +65,7 @@ 	stackExe <- Util.withCurrentDirectory (takeDirectory curExe) $
 		liftIO (findExecutable "stack") >>= maybe (hsdevError $ ToolNotFound "stack") return
 	comp <- stackCompiler
-	liftIO $ readProcess stackExe (cmd' ++ ["--compiler", comp, "--arch", stackArch]) ""
+	liftIO $ runTool_ stackExe (["--compiler", comp, "--arch", stackArch] ++ cmd')
 
 -- | Make yaml opts
 yaml :: Maybe FilePath -> [String]

src/HsDev/Symbols.hs view

@@ -58,7 +58,7 @@ import HsDev.Symbols.Types
 import HsDev.Symbols.Class
 import HsDev.Symbols.Documented (Documented(..))
-import HsDev.Util (searchPath, uniqueBy)
+import HsDev.Util (searchPath, uniqueBy, directoryContents)
 
 -- | Get name of export
 export :: Export -> Text
@@ -204,10 +204,10 @@ 	if isDir then locateHere file' else locateParent (takeDirectory file')
 	where
 		locateHere path = do
-			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents path
+			cts <- filter (not . null . takeBaseName) <$> directoryContents path
 			return $ fmap (project . (path </>)) $ find ((== ".cabal") . takeExtension) cts
 		locateParent dir = do
-			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents dir
+			cts <- filter (not . null . takeBaseName) <$> directoryContents dir
 			case find ((== ".cabal") . takeExtension) cts of
 				Nothing -> if isDrive dir then return Nothing else locateParent (takeDirectory dir)
 				Just cabalf -> return $ Just $ project (dir </> cabalf)

src/HsDev/Tools/Base.hs view

@@ -1,4 +1,5 @@ module HsDev.Tools.Base (
+	runTool, runTool_,
 	Result, ToolM,
 	runWait, runWait_,
 	tool, tool_,
@@ -27,6 +28,24 @@ import HsDev.Tools.Types
 import HsDev.Symbols
 import HsDev.Util (liftIOErrors)
+
+-- | Run tool, throwing HsDevError on fail
+runTool :: FilePath -> [String] -> String -> IO String
+runTool name args input = hsdevLiftIOWith onIOError $ do
+	(code, out, err) <- readProcessWithExitCode name args input
+	case code of
+		ExitFailure ecode -> hsdevError $ ToolError name $
+			"exited with code " ++ show ecode ++ ": " ++ err
+		ExitSuccess -> return out
+	where
+		onIOError s = ToolError name $ unlines [
+			"args: [" ++ intercalate ", " args ++ "]",
+			"stdin: " ++ input,
+			"error: " ++ s]
+
+-- | Run tool with not stdin
+runTool_ :: FilePath -> [String] -> IO String
+runTool_ name args = runTool name args ""
 
 type Result = Either String String
 type ToolM a = ExceptT String IO a

src/HsDev/Tools/ClearImports.hs view

@@ -74,7 +74,7 @@ -- | Clean temporary files
 cleanTmpImports :: FilePath -> IO ()
 cleanTmpImports dir = do
-	dumps <- liftM (map (dir </>) . filter ((== ".imports") . takeExtension)) $ getDirectoryContents dir
+	dumps <- liftM (filter ((== ".imports") . takeExtension)) $ directoryContents dir
 	forM_ dumps $ handle ignoreIO' . retry 1000 . removeFile
 	where
 		ignoreIO' :: IOException -> IO ()

src/HsDev/Tools/Ghc/Check.hs view

@@ -27,6 +27,7 @@ import HsDev.PackageDb
 import HsDev.Symbols.Location
 import HsDev.Symbols.Types
+import HsDev.Project (fileTarget)
 import HsDev.Tools.Base
 import HsDev.Tools.Ghc.Worker
 import HsDev.Tools.Ghc.Compat

src/HsDev/Tools/Ghc/MGhc.hs view

@@ -144,9 +144,6 @@ initSession = do
 	lib <- ask
 	initGhcMonad lib
-	fs <- getSessionDynFlags
-	void $ setSessionDynFlags fs
-	void $ liftIO $ initPackages fs
 	void saveSession
 
 activateSession :: (MonadIO m, ExceptionMonad m, Ord s) => s -> MGhcT s m (Maybe HscEnv)

src/HsDev/Tools/HDocs.hs view

@@ -19,11 +19,11 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.String (fromString)
-import System.Process (readProcess)
 
 import qualified HDocs.Module as HDocs
 import qualified HDocs.Haddock as HDocs (readSource, readSources_)
 
+import HsDev.Tools.Base
 import HsDev.Symbols
 
 -- | Get docs for modules
@@ -57,7 +57,5 @@ 	return $ setDocs d m
 
 hdocsProcess :: String -> [String] -> IO (Maybe (Map String String))
-hdocsProcess mname opts = handle onErr $ liftM (decode . L.pack . last . lines) $ readProcess "hdocs" opts' "" where
+hdocsProcess mname opts = liftM (decode . L.pack . last . lines) $ runTool_ "hdocs" opts' where
 	opts' = mname : concat [["-g", opt] | opt <- opts]
-	onErr :: SomeException -> IO (Maybe a)
-	onErr _ = return Nothing

src/HsDev/Util.hs view

@@ -70,11 +70,12 @@ withCurrentDirectory cur act = C.bracket (liftIO Dir.getCurrentDirectory) (liftIO . Dir.setCurrentDirectory) $
 	const (liftIO (Dir.setCurrentDirectory cur) >> act)
 
--- | Get directory contents safely
+-- | Get directory contents safely: no fail, ignoring symbolic links, also prepends paths with dir name
 directoryContents :: FilePath -> IO [FilePath]
 directoryContents p = handle ignore $ do
 	b <- Dir.doesDirectoryExist p
-	if b
+	isLink <- Dir.isSymbolicLink p
+	if b && (not isLink)
 		then liftM (map (p </>) . filter (`notElem` [".", ".."])) (Dir.getDirectoryContents p)
 		else return []
 	where
@@ -108,7 +109,9 @@ -- | Is one path parent of another
 isParent :: FilePath -> FilePath -> Bool
 isParent dir file = norm dir `isPrefixOf` norm file where
-	norm = splitDirectories . normalise
+	norm = dropDot . splitDirectories . normalise
+	dropDot ("." : chs) = chs
+	dropDot chs = chs
 
 -- | Is haskell source?
 haskellSource :: FilePath -> Bool

tests/Test.hs view

@@ -29,15 +29,19 @@ main :: IO ()
 main = hspec $ do
 	describe "scan project" $ do
+		dir <- runIO getCurrentDirectory
+		s <- runIO $ startServer (def { serverSilent = True })
 		it "should scan project" $ do
-			dir <- getCurrentDirectory
-			s <- startServer (def { serverSilent = True })
 			_ <- call s $ Scan [dir </> "tests/test-package"] False [] [] [] [] False False
 			one <- call s $ InfoResolve (dir </> "tests/test-package/ModuleOne.hs") True
-			when (["test", "forkIO", "f"] /= exports one) $
+			when (["test", "forkIO", "untypedFoo"] /= exports one) $
 				expectationFailure "invalid exports of ModuleOne.hs"
 			two <- call s $ InfoResolve (dir </> "tests/test-package/ModuleTwo.hs") True
-			when (["f", "twice"] /= exports two) $
+			when (["untypedFoo", "twice", "overloadedStrings"] /= exports two) $
 				expectationFailure "invalid exports of ModuleTwo.hs"
-			_ <- call s Exit
-			return ()
+		it "should pass extensions when checkings" $ do
+			checks <- call s (Check [FileSource (dir </> "tests/test-package/ModuleTwo.hs") Nothing] [])
+			when (("error" :: String) `elem` (checks ^.. traverseArray . key "level" . _Just)) $
+				expectationFailure "there should be no errors, only warnings"
+		_ <- runIO $ call s Exit
+		return ()

tests/test-package/ModuleOne.hs view

@@ -1,7 +1,7 @@ module ModuleOne (
 	test,
 	forkIO,
-	f
+	untypedFoo
 	) where
 
 import Control.Concurrent (forkIO)
@@ -11,4 +11,4 @@ test = return ()
 
 -- | Some function without type
-f x y = x + y
+untypedFoo x y = x + y

tests/test-package/ModuleTwo.hs view

@@ -1,10 +1,21 @@ module ModuleTwo (
-	f,
-	twice
+	untypedFoo,
+	twice,
+	overloadedStrings
 	) where
 
-import ModuleOne (f)
+import ModuleOne (untypedFoo)
 
+import Data.String
+
 -- | Apply function twice
 twice :: (a -> a) -> a -> a
 twice f = f . f
+
+data MyString = MyString String
+
+instance IsString MyString where
+	fromString = MyString
+
+overloadedStrings :: MyString
+overloadedStrings = "Hello"

tests/test-package/test-package.cabal view

@@ -3,7 +3,6 @@ synopsis:            hsdev test package
 -- description:         
 -- license:             
-license-file:        LICENSE
 author:              voidex
 maintainer:          voidex@live.com
 -- copyright:           
@@ -18,6 +17,8 @@     ModuleTwo
   -- other-modules:       
   -- other-extensions:    
-  build-depends:       base >=4.8 && <4.9
+  build-depends:       base
   hs-source-dirs:      .
   default-language:    Haskell2010
+  ghc-options: -Wall -fno-warn-tabs
+  default-extensions: OverloadedStrings