diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,7 @@ +0.9.0 +----- +* Support haddock comments + 0.8.8 ----- * Update README diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -54,22 +54,20 @@ import qualified Language.Haskell.Exts as HS import HsImport - type HsImportDecl = HS.ImportDecl HS.SrcSpanInfo - main :: IO () main = hsimport $ defaultConfig { prettyPrint = prettyPrint, findImportPos = findImportPos } where -- This is a bogus implementation of prettyPrint, because it doesn't handle the -- qualified import case nor does it considers any explicitely imported or hidden symbols. - prettyPrint :: HsImportDecl -> String - prettyPrint (HS.ImportDecl { HS.importModule = HS.ModuleName _ modName }) = + prettyPrint :: ImportDecl -> String + prettyPrint (ImportDecl { HS.importModule = HS.ModuleName _ modName }) = "import " ++ modName -- This findImportPos implementation will always add the new import declaration -- at the end of the current ones. The data type ImportPos has the two constructors -- After and Before. - findImportPos :: HsImportDecl -> [HsImportDecl] -> Maybe ImportPos - findImportPos _ [] = Nothing + findImportPos :: ImportDecl -> [ImportDecl] -> Maybe ImportPos + findImportPos _ [] = Nothing findImportPos newImport currentImports = Just . After . last $ currentImports The position of the configuration file depends on the result of `getUserConfigDir "hsimport"`, diff --git a/hsimport.cabal b/hsimport.cabal --- a/hsimport.cabal +++ b/hsimport.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.9.2 name: hsimport -version: 0.8.8 +version: 0.9.0 license: BSD3 license-file: LICENSE maintainer: daniel.trstenjak@gmail.com @@ -33,13 +33,14 @@ cpp-options: -DCABAL hs-source-dirs: lib other-modules: - HsImport.ImportSpec - HsImport.Module - HsImport.Symbol + HsImport.HsImportSpec + HsImport.ModuleImport + HsImport.SymbolImport HsImport.ImportChange HsImport.Parse HsImport.PrettyPrint HsImport.Utils + HsImport.Types Paths_hsimport ghc-options: -W build-depends: diff --git a/lib/HsImport.hs b/lib/HsImport.hs --- a/lib/HsImport.hs +++ b/lib/HsImport.hs @@ -3,10 +3,12 @@ ( module HsImport.Main , module HsImport.Config , module HsImport.Args + , ImportDecl , ImportPos(..) ) where import HsImport.Main import HsImport.Config import HsImport.Args +import HsImport.Types (ImportDecl) import HsImport.ImportPos (ImportPos(..)) diff --git a/lib/HsImport/Config.hs b/lib/HsImport/Config.hs --- a/lib/HsImport/Config.hs +++ b/lib/HsImport/Config.hs @@ -4,18 +4,16 @@ , defaultConfig ) where -import qualified Language.Haskell.Exts as HS import qualified HsImport.PrettyPrint as PP import qualified HsImport.ImportPos as IP - -type HsImportDecl = HS.ImportDecl HS.SrcSpanInfo +import HsImport.Types -- | User definable configuration for hsImport. data Config = Config { -- | function for pretty printing of the import declarations - prettyPrint :: HsImportDecl -> String + prettyPrint :: ImportDecl -> String -- | function for finding the position of new import declarations - , findImportPos :: HsImportDecl -> [HsImportDecl] -> Maybe IP.ImportPos + , findImportPos :: ImportDecl -> [ImportDecl] -> Maybe IP.ImportPos -- | error during configuration of hsimport , configError :: Maybe String } diff --git a/lib/HsImport/HsImportSpec.hs b/lib/HsImport/HsImportSpec.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/HsImportSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE TemplateHaskell, PatternGuards #-} + +module HsImport.HsImportSpec + ( HsImportSpec(..) + , hsImportSpec + ) where + +import qualified Language.Haskell.Exts as HS +import qualified HsImport.Args as Args +import HsImport.Args (HsImportArgs) +import HsImport.Parse (parseFile) +import HsImport.SymbolImport (SymbolImport(..)) +import HsImport.ModuleImport +import HsImport.Types +import Data.List (find) + +data HsImportSpec = HsImportSpec + { sourceFile :: FilePath + , parsedSrcFile :: Module + , moduleImport :: ModuleImport + , symbolImport :: Maybe SymbolImport + , saveToFile :: Maybe FilePath + } deriving (Show) + + +hsImportSpec :: HsImportArgs -> IO (Either Error HsImportSpec) +hsImportSpec args + | Just error <- checkArgs args = return $ Left error + | otherwise = do + result <- parseFile $ Args.inputSrcFile args + case result of + Right (HS.ParseOk hsModule) -> return $ Right $ + HsImportSpec { sourceFile = Args.inputSrcFile args + , parsedSrcFile = hsModule + , moduleImport = module_ + , symbolImport = symbolImport + , saveToFile = saveToFile + } + + Right (HS.ParseFailed srcLoc error) -> return $ Left (show srcLoc ++ error) + + Left error -> return $ Left error + + where + module_ = ModuleImport { moduleName = Args.moduleName args + , qualified = not . null $ Args.qualifiedName args + , as = find (/= "") [Args.qualifiedName args, Args.as args] + } + + symbolImport = + case Args.symbolName args of + "" -> Nothing + + name | Args.all args -> Just $ AllOfSymbol name + | ws@(_:_) <- Args.with args -> Just $ SomeOfSymbol name ws + | otherwise -> Just $ Symbol name + + saveToFile = + case Args.outputSrcFile args of + "" -> Nothing + fp -> Just fp + + checkArgs args + | null . Args.inputSrcFile $ args + = Just "Missing source file!" + + | null . Args.moduleName $ args + = Just "Missing module name!" + + | (not . null $ qualifiedName) && (not . null $ asName) + = Just "Invalid usage of options '--qualifiedname' and '--as' at once!" + + | otherwise + = Nothing + where + qualifiedName = Args.qualifiedName args + asName = Args.as args diff --git a/lib/HsImport/ImportChange.hs b/lib/HsImport/ImportChange.hs --- a/lib/HsImport/ImportChange.hs +++ b/lib/HsImport/ImportChange.hs @@ -10,34 +10,31 @@ import Lens.Micro import qualified Language.Haskell.Exts as HS import qualified Data.Attoparsec.Text as A -import HsImport.Symbol (Symbol(..)) -import HsImport.Module (Module(..)) +import HsImport.SymbolImport (SymbolImport(..)) +import HsImport.ModuleImport (ModuleImport(..)) import HsImport.ImportPos (matchingImports) import HsImport.Utils - -type SrcLine = Int -type HsImportDecl = HS.ImportDecl HS.SrcSpanInfo -type HsModule = HS.Module HS.SrcSpanInfo +import HsImport.Types -- | How the import declarations should be changed data ImportChange - = ReplaceImportAt HS.SrcSpan HsImportDecl -- ^ replace the import declaration at SrcSpan - | AddImportAfter SrcLine HsImportDecl -- ^ add import declaration after SrcLine - | AddImportAtEnd HsImportDecl -- ^ add import declaration at end of source file - | FindImportPos HsImportDecl -- ^ search for an insert position for the import declaration - | NoImportChange -- ^ no changes of the import declarations + = ReplaceImportAt SrcSpan ImportDecl -- ^ replace the import declaration at SrcSpan + | AddImportAfter SrcLine ImportDecl -- ^ add import declaration after SrcLine + | AddImportAtEnd ImportDecl -- ^ add import declaration at end of source file + | FindImportPos ImportDecl -- ^ search for an insert position for the import declaration + | NoImportChange -- ^ no changes of the import declarations deriving (Show) -importChanges :: Module -> Maybe Symbol -> HsModule -> [ImportChange] -importChanges (Module moduleName False Nothing) Nothing hsModule = +importChanges :: ModuleImport -> Maybe SymbolImport -> Module -> [ImportChange] +importChanges (ModuleImport moduleName False Nothing) Nothing hsModule = [ importModule moduleName hsModule ] -importChanges (Module moduleName False Nothing) (Just symbol) hsModule = - [ importModuleWithSymbol moduleName symbol hsModule ] +importChanges (ModuleImport moduleName False Nothing) (Just symbolImport) hsModule = + [ importModuleWithSymbol moduleName symbolImport hsModule ] -importChanges (Module moduleName qualified as) symbol hsModule = - [ maybe NoImportChange (\sym -> importModuleWithSymbol moduleName sym hsModule) symbol +importChanges (ModuleImport moduleName qualified as) symbolImport hsModule = + [ maybe NoImportChange (\sym -> importModuleWithSymbol moduleName sym hsModule) symbolImport , if qualified then importQualifiedModule moduleName (maybe moduleName id as) hsModule @@ -45,7 +42,7 @@ ] -importModule :: String -> HsModule -> ImportChange +importModule :: String -> Module -> ImportChange importModule moduleName module_ | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any entireModuleImported matching @@ -61,34 +58,34 @@ Nothing -> AddImportAtEnd (importDecl moduleName) -importModuleWithSymbol :: String -> Symbol -> HsModule -> ImportChange -importModuleWithSymbol moduleName symbol module_ +importModuleWithSymbol :: String -> SymbolImport -> Module -> ImportChange +importModuleWithSymbol moduleName symbolImport module_ | matching@(_:_) <- matchingImports moduleName (importDecls module_) = - if any entireModuleImported matching || any (symbolImported symbol) matching + if any entireModuleImported matching || any (symbolImported symbolImport) matching then NoImportChange else case find hasImportedSymbols matching of Just impDecl -> - ReplaceImportAt (srcSpan impDecl) (addSymbol impDecl symbol) + ReplaceImportAt (srcSpan . HS.ann $ impDecl) (addSymbol impDecl symbolImport) Nothing -> - FindImportPos $ importDeclWithSymbol moduleName symbol + FindImportPos $ importDeclWithSymbol moduleName symbolImport | not $ null (importDecls module_) = - FindImportPos $ importDeclWithSymbol moduleName symbol + FindImportPos $ importDeclWithSymbol moduleName symbolImport | otherwise = case srcLineForNewImport module_ of - Just srcLine -> AddImportAfter srcLine (importDeclWithSymbol moduleName symbol) - Nothing -> AddImportAtEnd (importDeclWithSymbol moduleName symbol) + Just srcLine -> AddImportAfter srcLine (importDeclWithSymbol moduleName symbolImport) + Nothing -> AddImportAtEnd (importDeclWithSymbol moduleName symbolImport) where - addSymbol (id@HS.ImportDecl {HS.importSpecs = specs}) symbol = - id {HS.importSpecs = specs & _Just %~ extendSpecList symbol} + addSymbol (id@HS.ImportDecl {HS.importSpecs = specs}) symbolImport = + id {HS.importSpecs = specs & _Just %~ extendSpecList symbolImport} - extendSpecList symbol (HS.ImportSpecList srcSpan hid specs) = - HS.ImportSpecList srcSpan hid (specs ++ [importSpec symbol]) + extendSpecList symbolImport (HS.ImportSpecList srcSpan hid specs) = + HS.ImportSpecList srcSpan hid (specs ++ [importSpec symbolImport]) -importQualifiedModule :: String -> String -> HsModule -> ImportChange +importQualifiedModule :: String -> String -> Module -> ImportChange importQualifiedModule moduleName qualifiedName module_ | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any (hasQualifiedImport qualifiedName) matching @@ -104,7 +101,7 @@ Nothing -> AddImportAtEnd (qualifiedImportDecl moduleName qualifiedName) -importModuleAs :: String -> String -> HsModule -> ImportChange +importModuleAs :: String -> String -> Module -> ImportChange importModuleAs moduleName asName module_ | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any (hasAsImport asName) matching @@ -120,12 +117,12 @@ Nothing -> AddImportAtEnd (asImportDecl moduleName asName) -entireModuleImported :: HsImportDecl -> Bool +entireModuleImported :: ImportDecl -> Bool entireModuleImported import_ = not (HS.importQualified import_) && isNothing (HS.importSpecs import_) -hasQualifiedImport :: String -> HsImportDecl -> Bool +hasQualifiedImport :: String -> ImportDecl -> Bool hasQualifiedImport qualifiedName import_ | HS.importQualified import_ , Just (HS.ModuleName _ importAs) <- HS.importAs import_ @@ -135,7 +132,7 @@ | otherwise = False -hasAsImport :: String -> HsImportDecl -> Bool +hasAsImport :: String -> ImportDecl -> Bool hasAsImport asName import_ | not $ HS.importQualified import_ , Just (HS.ModuleName _ importAs) <- HS.importAs import_ @@ -146,10 +143,10 @@ = False -symbolImported :: Symbol -> HsImportDecl -> Bool -symbolImported symbol import_ +symbolImported :: SymbolImport -> ImportDecl -> Bool +symbolImported symbolImport import_ | Just (HS.ImportSpecList _ False hsSymbols) <- HS.importSpecs import_ - , any (imports symbol) hsSymbols + , any (imports symbolImport) hsSymbols = True | otherwise @@ -173,7 +170,7 @@ toName (HS.ConName _ name) = name -hasImportedSymbols :: HsImportDecl -> Bool +hasImportedSymbols :: ImportDecl -> Bool hasImportedSymbols import_ | Just (HS.ImportSpecList _ False (_:_)) <- HS.importSpecs import_ = True @@ -181,10 +178,10 @@ | otherwise = False -importDecl :: String -> HsImportDecl +importDecl :: String -> ImportDecl importDecl moduleName = HS.ImportDecl - { HS.importAnn = HS.noSrcSpan - , HS.importModule = HS.ModuleName HS.noSrcSpan moduleName + { HS.importAnn = noAnnotation + , HS.importModule = HS.ModuleName noAnnotation moduleName , HS.importQualified = False , HS.importSrc = False , HS.importSafe = False @@ -194,60 +191,61 @@ } -importDeclWithSymbol :: String -> Symbol -> HsImportDecl -importDeclWithSymbol moduleName symbol = - (importDecl moduleName) { HS.importSpecs = Just (HS.ImportSpecList HS.noSrcSpan +importDeclWithSymbol :: String -> SymbolImport -> ImportDecl +importDeclWithSymbol moduleName symbolImport = + (importDecl moduleName) { HS.importSpecs = Just (HS.ImportSpecList noAnnotation False - [importSpec symbol]) + [importSpec symbolImport]) } -qualifiedImportDecl :: String -> String -> HsImportDecl +qualifiedImportDecl :: String -> String -> ImportDecl qualifiedImportDecl moduleName qualifiedName = (importDecl moduleName) { HS.importQualified = True , HS.importAs = if moduleName /= qualifiedName - then Just $ HS.ModuleName HS.noSrcSpan qualifiedName + then Just $ HS.ModuleName noAnnotation qualifiedName else Nothing } -asImportDecl :: String -> String -> HsImportDecl +asImportDecl :: String -> String -> ImportDecl asImportDecl moduleName asName = (importDecl moduleName) { HS.importQualified = False - , HS.importAs = Just $ HS.ModuleName HS.noSrcSpan asName + , HS.importAs = Just $ HS.ModuleName noAnnotation asName } -importSpec :: Symbol -> HS.ImportSpec HS.SrcSpanInfo -importSpec (Symbol symName) = HS.IVar HS.noSrcSpan (hsName symName) -importSpec (AllOfSymbol symName) = HS.IThingAll HS.noSrcSpan (hsName symName) -importSpec (SomeOfSymbol symName names) = HS.IThingWith HS.noSrcSpan +importSpec :: SymbolImport -> ImportSpec +importSpec (Symbol symName) = HS.IVar noAnnotation (hsName symName) +importSpec (AllOfSymbol symName) = HS.IThingAll noAnnotation (hsName symName) +importSpec (SomeOfSymbol symName names) = HS.IThingWith noAnnotation (hsName symName) - (map ((HS.VarName HS.noSrcSpan) . hsName) names) + (map ((HS.VarName noAnnotation) . hsName) names) -hsName :: String -> HS.Name HS.SrcSpanInfo +hsName :: String -> Name hsName symbolName - | isSymbol = HS.Symbol HS.noSrcSpan symbolName - | otherwise = HS.Ident HS.noSrcSpan symbolName + | isSymbol = HS.Symbol noAnnotation symbolName + | otherwise = HS.Ident noAnnotation symbolName where isSymbol = any (A.notInClass "a-zA-Z0-9_'") symbolName -srcLineForNewImport :: HsModule -> Maybe SrcLine +srcLineForNewImport :: Module -> Maybe SrcLine srcLineForNewImport module_ = case module_ of - HS.Module srcSpan _ _ imports decls -> newSrcLine srcSpan imports decls - HS.XmlPage _ _ _ _ _ _ _ -> Nothing - HS.XmlHybrid srcSpan _ _ imports decls _ _ _ _ -> newSrcLine srcSpan imports decls + HS.Module ann _ _ imports decls -> newSrcLine ann imports decls + HS.XmlPage _ _ _ _ _ _ _ -> Nothing + HS.XmlHybrid ann _ _ imports decls _ _ _ _ -> newSrcLine ann imports decls where - newSrcLine srcSpan imports decls + newSrcLine :: Annotation -> [ImportDecl] -> [Decl] -> Maybe SrcLine + newSrcLine ann imports decls | not $ null imports - = Just (firstSrcLine $ last imports) + = Just (firstSrcLine . HS.ann $ last imports) | (decl:_) <- decls , sLoc <- declSrcLoc decl - , HS.srcLine sLoc >= HS.startLine srcSpan + , HS.srcLine sLoc >= firstSrcLine ann = Just $ max 0 (HS.srcLine sLoc - 1) | otherwise diff --git a/lib/HsImport/ImportPos.hs b/lib/HsImport/ImportPos.hs --- a/lib/HsImport/ImportPos.hs +++ b/lib/HsImport/ImportPos.hs @@ -10,30 +10,28 @@ import qualified Language.Haskell.Exts as HS import Data.List.Index (ifoldl') import Data.List.Split (splitOn) +import HsImport.Types #if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) #endif -type ModuleName = String -type HsImportDecl = HS.ImportDecl HS.SrcSpanInfo - -- | Where a new import declaration should be added. -data ImportPos = Before HsImportDecl -- ^ before the specified import declaration - | After HsImportDecl -- ^ after the specified import declaration +data ImportPos = Before ImportDecl -- ^ before the specified import declaration + | After ImportDecl -- ^ after the specified import declaration deriving (Show, Eq) -- | Returns the position where the import declaration for the -- new import should be put into the list of import declarations. -findImportPos :: HsImportDecl -> [HsImportDecl] -> Maybe ImportPos +findImportPos :: ImportDecl -> [ImportDecl] -> Maybe ImportPos findImportPos newImport imports = After <$> bestMatchingImport name imports where HS.ModuleName _ name = HS.importModule newImport -- | Returns all import declarations having the same module name. -matchingImports :: ModuleName -> [HsImportDecl] -> [HsImportDecl] +matchingImports :: ModuleName -> [ImportDecl] -> [ImportDecl] matchingImports moduleName imports = [ i | i@HS.ImportDecl {HS.importModule = HS.ModuleName _ name} <- imports @@ -44,7 +42,7 @@ -- | Returns the best matching import declaration for the given module name. -- E.g. if the module name is "Foo.Bar.Boo", then "Foo.Bar" is considered -- better matching than "Foo". -bestMatchingImport :: ModuleName -> [HsImportDecl] -> Maybe HsImportDecl +bestMatchingImport :: ModuleName -> [ImportDecl] -> Maybe ImportDecl bestMatchingImport _ [] = Nothing bestMatchingImport moduleName imports = case ifoldl' computeMatches Nothing splittedMods of diff --git a/lib/HsImport/ImportSpec.hs b/lib/HsImport/ImportSpec.hs deleted file mode 100644 --- a/lib/HsImport/ImportSpec.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE TemplateHaskell, PatternGuards #-} - -module HsImport.ImportSpec - ( ImportSpec(..) - , hsImportSpec - ) where - -import qualified Language.Haskell.Exts as HS -import qualified HsImport.Args as Args -import HsImport.Args (HsImportArgs) -import HsImport.Parse (parseFile) -import HsImport.Symbol (Symbol(..)) -import HsImport.Module -import Data.List (find) - -data ImportSpec = ImportSpec - { sourceFile :: FilePath - , parsedSrcFile :: HS.Module HS.SrcSpanInfo - , moduleToImport :: Module - , symbolToImport :: Maybe Symbol - , saveToFile :: Maybe FilePath - } deriving (Show) - - -type Error = String -hsImportSpec :: HsImportArgs -> IO (Either Error ImportSpec) -hsImportSpec args - | Just error <- checkArgs args = return $ Left error - | otherwise = do - result <- parseFile $ Args.inputSrcFile args - case result of - Right (HS.ParseOk hsModule) -> return $ Right $ - ImportSpec { sourceFile = Args.inputSrcFile args - , parsedSrcFile = hsModule - , moduleToImport = module_ - , symbolToImport = symbol - , saveToFile = saveToFile - } - - Right (HS.ParseFailed srcLoc error) -> return $ Left (show srcLoc ++ error) - - Left error -> return $ Left error - - where - module_ = Module { moduleName = Args.moduleName args - , qualified = not . null $ Args.qualifiedName args - , as = find (/= "") [Args.qualifiedName args, Args.as args] - } - - symbol = - case Args.symbolName args of - "" -> Nothing - - name | Args.all args -> Just $ AllOfSymbol name - | ws@(_:_) <- Args.with args -> Just $ SomeOfSymbol name ws - | otherwise -> Just $ Symbol name - - saveToFile = - case Args.outputSrcFile args of - "" -> Nothing - fp -> Just fp - - checkArgs args - | null . Args.inputSrcFile $ args - = Just "Missing source file!" - - | null . Args.moduleName $ args - = Just "Missing module name!" - - | (not . null $ qualifiedName) && (not . null $ asName) - = Just "Invalid usage of options '--qualifiedname' and '--as' at once!" - - | otherwise - = Nothing - where - qualifiedName = Args.qualifiedName args - asName = Args.as args diff --git a/lib/HsImport/Main.hs b/lib/HsImport/Main.hs --- a/lib/HsImport/Main.hs +++ b/lib/HsImport/Main.hs @@ -15,7 +15,7 @@ import qualified Config.Dyre as Dyre import qualified Language.Haskell.Exts as HS import HsImport.ImportChange -import HsImport.ImportSpec +import HsImport.HsImportSpec import HsImport.ImportPos (ImportPos(..)) import qualified HsImport.Args as Args import HsImport.Config @@ -55,9 +55,9 @@ Right spec -> hsimportWithSpec config spec >> return Nothing -hsimportWithSpec :: Config -> ImportSpec -> IO () +hsimportWithSpec :: Config -> HsImportSpec -> IO () hsimportWithSpec Config { prettyPrint = prettyPrint, findImportPos = findImportPos } spec = do - let impChanges = importChanges (moduleToImport spec) (symbolToImport spec) (parsedSrcFile spec) + let impChanges = importChanges (moduleImport spec) (symbolImport spec) (parsedSrcFile spec) srcLines <- lines . T.unpack <$> TIO.readFile (sourceFile spec) let srcLines' = applyChanges srcLines impChanges @@ -82,11 +82,11 @@ applyChange srcLines (FindImportPos importDecl) = case findImportPos importDecl allImportDecls of - Just (After impDecl) -> applyChange srcLines (AddImportAfter (lastSrcLine impDecl) + Just (After impDecl) -> applyChange srcLines (AddImportAfter (lastSrcLine . HS.ann $ impDecl) importDecl) - Just (Before impDecl) -> applyChange srcLines (AddImportAfter (max 0 (firstSrcLine impDecl - 1)) + Just (Before impDecl) -> applyChange srcLines (AddImportAfter (max 0 ((firstSrcLine . HS.ann $ impDecl) - 1)) importDecl) - _ -> applyChange srcLines (AddImportAfter (lastSrcLine . last $ allImportDecls) + _ -> applyChange srcLines (AddImportAfter (lastSrcLine . HS.ann . last $ allImportDecls) importDecl) applyChange srcLines NoImportChange = srcLines diff --git a/lib/HsImport/Module.hs b/lib/HsImport/Module.hs deleted file mode 100644 --- a/lib/HsImport/Module.hs +++ /dev/null @@ -1,13 +0,0 @@ - -module HsImport.Module - ( Module(..) - , Name - ) where - -type Name = String - --- | How the module should be imported -data Module = Module { moduleName :: Name -- ^ the name of the module to import - , qualified :: Bool -- ^ if the module should be imported qualified - , as :: Maybe Name -- ^ the module should be imported with this name - } deriving (Show) diff --git a/lib/HsImport/ModuleImport.hs b/lib/HsImport/ModuleImport.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/ModuleImport.hs @@ -0,0 +1,14 @@ + +module HsImport.ModuleImport + ( ModuleImport(..) + , Name + ) where + +type Name = String + +-- | How the module should be imported +data ModuleImport = ModuleImport + { moduleName :: Name -- ^ the name of the module to import + , qualified :: Bool -- ^ if the module should be imported qualified + , as :: Maybe Name -- ^ the module should be imported with this name + } deriving (Show) diff --git a/lib/HsImport/Parse.hs b/lib/HsImport/Parse.hs --- a/lib/HsImport/Parse.hs +++ b/lib/HsImport/Parse.hs @@ -15,12 +15,11 @@ import Control.Applicative ((<$>)) #endif -type Error = String -type HsParseResult = HS.ParseResult (HS.Module HS.SrcSpanInfo) +import HsImport.Types -parseFile :: FilePath -> IO (Either Error HsParseResult) +parseFile :: FilePath -> IO (Either Error ParseResult) parseFile file = do - srcFile <- unlines. replaceCPPByComment . lines . T.unpack <$> TIO.readFile file + srcFile <- unlines. replaceCPPByEmptyLine . lines . T.unpack <$> TIO.readFile file catch (do let result = parseFileContents srcFile case result of HS.ParseOk _ -> return $ Right result @@ -34,20 +33,20 @@ srcResult <- parseInvalidSource srcLines (length srcLines) return $ maybe (Left $ show e) Right srcResult) where - -- | replace CPP directives by a fake comment - replaceCPPByComment = map $ \line -> + -- | replace CPP directives by an empty line + replaceCPPByEmptyLine = map $ \line -> if "#" `isPrefixOf` line - then "-- fake hsimport comment" + then "" else line -- | tries to find the maximal part of the source file (from the beginning) that contains -- valid/complete Haskell code -parseInvalidSource :: [String] -> Int -> IO (Maybe HsParseResult) +parseInvalidSource :: [String] -> Int -> IO (Maybe ParseResult) parseInvalidSource srcLines firstInvalidLine = do parseInvalidSource' 1 firstInvalidLine Nothing 0 where - parseInvalidSource' :: Int -> Int -> Maybe (Int, HsParseResult) -> Int -> IO (Maybe HsParseResult) + parseInvalidSource' :: Int -> Int -> Maybe (Int, ParseResult) -> Int -> IO (Maybe ParseResult) parseInvalidSource' lastValidLine currLastLine maxParseOk iteration | null srcLines || lastValidLine >= currLastLine = return Nothing @@ -84,7 +83,13 @@ _ -> Just (nextLine, nextResult) -parseFileContents :: String -> HsParseResult -parseFileContents = HS.parseFileContentsWithMode parseMode +parseFileContents :: String -> ParseResult +parseFileContents contents = + let result = HS.parseFileContentsWithComments parseMode contents + in case result of + HS.ParseOk res -> HS.ParseOk $ HS.associateHaddock res + HS.ParseFailed sloc msg -> HS.ParseFailed sloc msg + where parseMode = HS.defaultParseMode { HS.fixities = Just [] } + diff --git a/lib/HsImport/PrettyPrint.hs b/lib/HsImport/PrettyPrint.hs --- a/lib/HsImport/PrettyPrint.hs +++ b/lib/HsImport/PrettyPrint.hs @@ -10,8 +10,9 @@ import Data.Monoid (mconcat) #endif +import HsImport.Types -prettyPrint :: HS.ImportDecl HS.SrcSpanInfo -> String +prettyPrint :: ImportDecl -> String prettyPrint importDecl = -- remove newlines from pretty printed ImportDecl case lines $ HS.prettyPrint importDecl of diff --git a/lib/HsImport/Symbol.hs b/lib/HsImport/Symbol.hs deleted file mode 100644 --- a/lib/HsImport/Symbol.hs +++ /dev/null @@ -1,12 +0,0 @@ - -module HsImport.Symbol - ( Symbol(..) - ) where - -type Name = String - --- | What of the symbol should be imported. -data Symbol = Symbol Name -- ^ only the symbol should be imported - | AllOfSymbol Name -- ^ all constructors or methods of the symbol should be imported: Symbol(..) - | SomeOfSymbol Name [String] -- ^ some constructors or methods of the symbol should be imported: Symbol(X, Y) - deriving (Show) diff --git a/lib/HsImport/SymbolImport.hs b/lib/HsImport/SymbolImport.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/SymbolImport.hs @@ -0,0 +1,13 @@ + +module HsImport.SymbolImport + ( SymbolImport(..) + ) where + +type Name = String + +-- | What of the symbol should be imported. +data SymbolImport + = Symbol Name -- ^ only the symbol should be imported + | AllOfSymbol Name -- ^ all constructors or methods of the symbol should be imported: Symbol(..) + | SomeOfSymbol Name [String] -- ^ some constructors or methods of the symbol should be imported: Symbol(X, Y) + deriving (Show) diff --git a/lib/HsImport/Types.hs b/lib/HsImport/Types.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/Types.hs @@ -0,0 +1,46 @@ + +module HsImport.Types where + +import qualified Language.Haskell.Exts as HS + +type SrcLine = Int +type SrcColumn = Int +type SrcSpan = HS.SrcSpan +type SrcLoc = HS.SrcLoc +type Annotation = (HS.SrcSpanInfo, [HS.Comment]) +type Decl = HS.Decl Annotation +type ImportDecl = HS.ImportDecl Annotation +type ImportSpec = HS.ImportSpec Annotation +type Name = HS.Name Annotation +type Module = HS.Module Annotation +type ModuleName = String +type ParseResult = HS.ParseResult Module +type Error = String + +firstSrcLine :: Annotation -> SrcLine +firstSrcLine = minimum . map HS.srcSpanStartLine . srcSpans + +lastSrcLine :: Annotation -> SrcLine +lastSrcLine = maximum . map HS.srcSpanEndLine . srcSpans + +firstSrcColumn :: Annotation -> SrcColumn +firstSrcColumn = minimum . map HS.srcSpanStartColumn . srcSpans + +lastSrcColumn :: Annotation -> SrcColumn +lastSrcColumn = maximum . map HS.srcSpanEndColumn . srcSpans + +srcSpan :: Annotation -> SrcSpan +srcSpan ann@(HS.SrcSpanInfo srcSpan _, _) = + srcSpan { HS.srcSpanStartLine = firstSrcLine ann + , HS.srcSpanStartColumn = firstSrcColumn ann + , HS.srcSpanEndLine = lastSrcLine ann + , HS.srcSpanEndColumn = lastSrcColumn ann + } + +srcSpans :: Annotation -> [SrcSpan] +srcSpans (HS.SrcSpanInfo srcSpan _, comments) = srcSpan : commentSrcSpans + where + commentSrcSpans = map (\(HS.Comment _ srcSpan _) -> srcSpan) comments + +noAnnotation :: Annotation +noAnnotation = (HS.noSrcSpan, []) diff --git a/lib/HsImport/Utils.hs b/lib/HsImport/Utils.hs --- a/lib/HsImport/Utils.hs +++ b/lib/HsImport/Utils.hs @@ -8,33 +8,18 @@ ) where import qualified Language.Haskell.Exts as HS - -type SrcLine = Int -type HsImportDecl = HS.ImportDecl HS.SrcSpanInfo -type HsModule = HS.Module HS.SrcSpanInfo - -firstSrcLine :: HsImportDecl -> SrcLine -firstSrcLine = HS.startLine . HS.importAnn - - -srcSpan :: HsImportDecl -> HS.SrcSpan -srcSpan = HS.srcInfoSpan . HS.importAnn - - -lastSrcLine :: HsImportDecl -> SrcLine -lastSrcLine = HS.srcSpanEndLine . srcSpan - +import HsImport.Types -declSrcLoc :: HS.Decl HS.SrcSpanInfo -> HS.SrcLoc +declSrcLoc :: Decl -> SrcLoc declSrcLoc decl = HS.SrcLoc srcFile srcLine srcCol where - srcSpan = HS.srcInfoSpan . HS.ann $ decl - srcFile = HS.srcSpanFilename srcSpan - srcLine = HS.srcSpanStartLine srcSpan - srcCol = HS.srcSpanStartColumn srcSpan + declSrcSpan = srcSpan . HS.ann $ decl + srcFile = HS.srcSpanFilename declSrcSpan + srcLine = HS.srcSpanStartLine declSrcSpan + srcCol = HS.srcSpanStartColumn declSrcSpan -importDecls :: HsModule -> [HsImportDecl] +importDecls :: Module -> [ImportDecl] importDecls (HS.Module _ _ _ imports _) = imports importDecls (HS.XmlPage _ _ _ _ _ _ _) = [] importDecls (HS.XmlHybrid _ _ _ imports _ _ _ _ _) = imports diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -9,8 +9,6 @@ import qualified Language.Haskell.Exts as HS import qualified HsImport as HI -type ImportDecl = HS.ImportDecl HS.SrcSpanInfo - main = defaultMain tests tests :: TestTree @@ -50,6 +48,11 @@ , test_ "ModuleTest29" (HI.defaultConfig { HI.findImportPos = importPosBeforeLast }) (HI.defaultArgs { HI.moduleName = "Control.Monad" }) , test_ "ModuleTest30" (HI.defaultConfig { HI.findImportPos = importPosAfterLast }) (HI.defaultArgs { HI.moduleName = "Control.Monad" }) , test "ModuleTest31" $ HI.defaultArgs { HI.moduleName = "Control.Monad", HI.as = "CM" } + , test "ModuleTest32" $ HI.defaultArgs { HI.moduleName = "Control.Monad" } + , test "ModuleTest33" $ HI.defaultArgs { HI.moduleName = "Control.Monad" } + , test "ModuleTest34" $ HI.defaultArgs { HI.moduleName = "Control.Monad" } + , test "ModuleTest35" $ HI.defaultArgs { HI.moduleName = "Control.Monad" } + , test "ModuleTest36" $ HI.defaultArgs { HI.moduleName = "Control.Monad" } ] @@ -112,7 +115,7 @@ inputFile = "tests" "inputFiles" testName <.> "hs" -prettyPrint :: ImportDecl -> String +prettyPrint :: HI.ImportDecl -> String prettyPrint HS.ImportDecl { HS.importModule = HS.ModuleName _ modName, HS.importSpecs = Just (HS.ImportSpecList _ False syms) } = "import " ++ modName ++ " ( " ++ ppSyms ++ " )" where @@ -125,21 +128,21 @@ prettyPrint _ = "Uupps" -importPosAfterLast :: ImportDecl -> [ImportDecl] -> Maybe HI.ImportPos +importPosAfterLast :: HI.ImportDecl -> [HI.ImportDecl] -> Maybe HI.ImportPos importPosAfterLast _ [] = Nothing importPosAfterLast _ imports = Just . HI.After . last $ imports -importPosBeforeLast :: ImportDecl -> [ImportDecl] -> Maybe HI.ImportPos +importPosBeforeLast :: HI.ImportDecl -> [HI.ImportDecl] -> Maybe HI.ImportPos importPosBeforeLast _ [] = Nothing importPosBeforeLast _ imports = Just . HI.Before . last $ imports -importPosAfterFirst :: ImportDecl -> [ImportDecl] -> Maybe HI.ImportPos +importPosAfterFirst :: HI.ImportDecl -> [HI.ImportDecl] -> Maybe HI.ImportPos importPosAfterFirst _ [] = Nothing importPosAfterFirst _ imports = Just . HI.After . head $ imports -importPosBeforeFirst :: ImportDecl -> [ImportDecl] -> Maybe HI.ImportPos +importPosBeforeFirst :: HI.ImportDecl -> [HI.ImportDecl] -> Maybe HI.ImportPos importPosBeforeFirst _ [] = Nothing importPosBeforeFirst _ imports = Just . HI.Before . head $ imports diff --git a/tests/goldenFiles/ModuleTest32.hs b/tests/goldenFiles/ModuleTest32.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest32.hs @@ -0,0 +1,14 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +-- | Some Haddock doc +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest33.hs b/tests/goldenFiles/ModuleTest33.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest33.hs @@ -0,0 +1,15 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +-- | Some Haddock doc +-- One line more +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest34.hs b/tests/goldenFiles/ModuleTest34.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest34.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +{-| + Some Haddock doc + One line more +-} +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest35.hs b/tests/goldenFiles/ModuleTest35.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest35.hs @@ -0,0 +1,14 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +f :: Int -> Int +-- ^ Some Haddock doc +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest36.hs b/tests/goldenFiles/ModuleTest36.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest36.hs @@ -0,0 +1,15 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +f :: Int -> Int +-- ^ Some Haddock doc +-- One line more +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest32.hs b/tests/inputFiles/ModuleTest32.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest32.hs @@ -0,0 +1,13 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +-- | Some Haddock doc +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest33.hs b/tests/inputFiles/ModuleTest33.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest33.hs @@ -0,0 +1,14 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +-- | Some Haddock doc +-- One line more +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest34.hs b/tests/inputFiles/ModuleTest34.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest34.hs @@ -0,0 +1,16 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +{-| + Some Haddock doc + One line more +-} +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest35.hs b/tests/inputFiles/ModuleTest35.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest35.hs @@ -0,0 +1,13 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +f :: Int -> Int +-- ^ Some Haddock doc +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest36.hs b/tests/inputFiles/ModuleTest36.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest36.hs @@ -0,0 +1,14 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +f :: Int -> Int +-- ^ Some Haddock doc +-- One line more +f = (+ 3) + +g :: Int -> Int +g = + where