diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -38,6 +38,51 @@ $> hsimport -m 'Data.Maybe' -s 'Maybe' -w 'Just' -w 'Nothing' => import Data.Maybe (Maybe(Just, Nothing)) +Configuration +------------- + +You can configure how the import declarations are pretty printed and where they're placed +by writing a configuration file like: + + -- ~/.config/hsimport/hsimport.hs + import qualified Language.Haskell.Exts as HS + import HsImport + + 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 :: HS.ImportDecl -> String + prettyPrint (HS.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 :: HS.ImportDecl -> [HS.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"`, +which is a function from the package [xdg-basedir](), +on linux like systems it is `~/.config/hsimport/hsimport.hs`. + +If you've modified the configuration file, then the next call of `hsimport` will ensure a rebuild. +If you've installed `hsimport` with `cabal install`, without using a sandbox, then this should just work. + +If you've build `hsimport` inside of a sandbox, then you most likely have to temporary modify the +`GHC_PACKAGE_PATH` for the next call of `hsimport`, to point `ghc` to the global database and +to the package database of the sandbox. + + # global package database + $> export GLOBAL_PKG_DB=/usr/lib/ghc/package.conf.d/ + + # hsimport sandbox package database + $> export SANDBOX_PKG_DB=/home/you/hsimport-build-dir/.cabal-sandbox/*-packages.conf.d/ + + $> GHC_PACKAGE_PATH=$GLOBAL_PKG_DB:$SANDBOX_PKG_DB hsimport --help + Text Editor Integration ----------------------- diff --git a/exe/Main.hs b/exe/Main.hs --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,14 +1,7 @@ module Main where -import System.Exit (exitFailure, exitSuccess) -import System.IO (hPutStrLn, stderr) import HsImport main :: IO () -main = do - args <- hsImportArgs - maybeSpec <- hsImportSpec args - case maybeSpec of - Left error -> hPutStrLn stderr ("hsimport: " ++ error) >> exitFailure - Right spec -> hsImport spec >> exitSuccess +main = hsimport defaultConfig diff --git a/hsimport.cabal b/hsimport.cabal --- a/hsimport.cabal +++ b/hsimport.cabal @@ -1,5 +1,5 @@ name: hsimport -version: 0.4 +version: 0.5 cabal-version: >=1.9.2 build-type: Simple license: BSD3 @@ -25,18 +25,21 @@ base >=3 && <5, cmdargs >=0.10.5 && <0.11, haskell-src-exts >=1.14.0 && <1.16, - lens >=3.9.2 && <4.3, + lens >=3.9.2 && <4.4, mtl >=2.1.2 && <2.3, text >=0.11.3.1 && <1.2, split >=0.2.2 && <0.3, attoparsec >=0.10.4.0 && <0.13, - directory >=1.2.0.1 && <1.3 + directory >=1.2.0.1 && <1.3, + dyre ==0.8.* exposed-modules: HsImport + HsImport.Main + HsImport.Config HsImport.Args HsImport.ImportSpec HsImport.Symbol - HsImport.Main + HsImport.ImportPos exposed: True buildable: True cpp-options: -DCABAL @@ -44,6 +47,8 @@ other-modules: HsImport.ImportChange HsImport.Parse + HsImport.PrettyPrint + HsImport.Utils Paths_hsimport ghc-options: -W @@ -55,6 +60,7 @@ buildable: True cpp-options: -DCABAL hs-source-dirs: exe + ghc-prof-options: -prof -fprof-auto -rtsopts ghc-options: -W test-suite hsimport-tests @@ -63,6 +69,7 @@ tasty >=0.6 && <0.9, tasty-golden >=2.2.0.1 && <2.3, filepath >=1.3.0.1 && <1.4, + haskell-src-exts >=1.14.0 && <1.16, hsimport -any type: exitcode-stdio-1.0 main-is: Main.hs diff --git a/lib/HsImport.hs b/lib/HsImport.hs --- a/lib/HsImport.hs +++ b/lib/HsImport.hs @@ -1,13 +1,10 @@ module HsImport - ( HsImportArgs - , hsImportArgs - , module HsImport.ImportSpec - , module HsImport.Symbol - , module HsImport.Main + ( module HsImport.Main + , module HsImport.Config + , ImportPos(..) ) where -import HsImport.Args -import HsImport.ImportSpec -import HsImport.Symbol import HsImport.Main +import HsImport.Config +import HsImport.ImportPos (ImportPos(..)) diff --git a/lib/HsImport/Config.hs b/lib/HsImport/Config.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/Config.hs @@ -0,0 +1,27 @@ + +module HsImport.Config + ( Config(..) + , defaultConfig + ) where + +import qualified Language.Haskell.Exts as HS +import qualified HsImport.PrettyPrint as PP +import qualified HsImport.ImportPos as IP + +-- | User definable configuration for hsImport. +data Config = Config + { -- | function for pretty printing of the import declarations + prettyPrint :: HS.ImportDecl -> String + -- | function for finding the position of new import declarations + , findImportPos :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe IP.ImportPos + -- | error during configuration of hsimport + , configError :: Maybe String + } + + +defaultConfig :: Config +defaultConfig = Config + { prettyPrint = PP.prettyPrint + , findImportPos = IP.findImportPos + , configError = Nothing + } diff --git a/lib/HsImport/ImportChange.hs b/lib/HsImport/ImportChange.hs --- a/lib/HsImport/ImportChange.hs +++ b/lib/HsImport/ImportChange.hs @@ -7,20 +7,21 @@ import Data.Maybe import Data.List (find, (\\)) -import Data.List.Split (splitOn) import Control.Lens import qualified Language.Haskell.Exts as HS import qualified Data.Attoparsec.Text as A -import Data.Monoid (mconcat) import HsImport.Symbol (Symbol(..)) +import HsImport.ImportPos (matchingImports) +import HsImport.Utils -type SrcLine = Int -type ImportString = String +type SrcLine = Int -data ImportChange = ReplaceImportAt SrcLine ImportString - | AddImportAfter SrcLine ImportString - | AddImportAtEnd ImportString - | NoImportChange +-- | How the import declarations should be changed +data ImportChange = ReplaceImportAt SrcLine HS.ImportDecl -- ^ replace the import declaration at SrcLine + | AddImportAfter SrcLine HS.ImportDecl -- ^ add import declaration after SrcLine + | AddImportAtEnd HS.ImportDecl -- ^ add import declaration at end of source file + | FindImportPos HS.ImportDecl -- ^ search for an insert position for the import declaration + | NoImportChange -- ^ no changes of the import declarations deriving (Show) @@ -42,105 +43,58 @@ importModule :: String -> HS.Module -> ImportChange importModule moduleName module_ - | matching@(_:_) <- matchingImports moduleName module_ = + | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any entireModuleImported matching then NoImportChange - else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ importDecl moduleName) + else FindImportPos $ importDecl moduleName - | Just bestMatch <- bestMatchingImport moduleName module_ = - AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ importDecl moduleName) + | not $ null (importDecls module_) = + FindImportPos $ importDecl moduleName | otherwise = case srcLineForNewImport module_ of - Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ importDecl moduleName) - Nothing -> AddImportAtEnd (HS.prettyPrint $ importDecl moduleName) + Just srcLine -> AddImportAfter srcLine (importDecl moduleName) + Nothing -> AddImportAtEnd (importDecl moduleName) importModuleWithSymbol :: String -> Symbol -> HS.Module -> ImportChange importModuleWithSymbol moduleName symbol module_ - | matching@(_:_) <- matchingImports moduleName module_ = + | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any entireModuleImported matching || any (symbolImported symbol) matching then NoImportChange else case find hasImportedSymbols matching of Just impDecl -> - ReplaceImportAt (srcLine impDecl) (prettyPrint $ addSymbol impDecl symbol) + ReplaceImportAt (srcLine impDecl) (addSymbol impDecl symbol) Nothing -> - AddImportAfter (srcLine . last $ matching) - (prettyPrint $ importDeclWithSymbol moduleName symbol) + FindImportPos $ importDeclWithSymbol moduleName symbol - | Just bestMatch <- bestMatchingImport moduleName module_ = - AddImportAfter (srcLine bestMatch) (prettyPrint $ importDeclWithSymbol moduleName symbol) + | not $ null (importDecls module_) = + FindImportPos $ importDeclWithSymbol moduleName symbol | otherwise = case srcLineForNewImport module_ of - Just srcLine -> AddImportAfter srcLine (prettyPrint $ importDeclWithSymbol moduleName symbol) - Nothing -> AddImportAtEnd (prettyPrint $ importDeclWithSymbol moduleName symbol) + Just srcLine -> AddImportAfter srcLine (importDeclWithSymbol moduleName symbol) + Nothing -> AddImportAtEnd (importDeclWithSymbol moduleName symbol) where addSymbol (id@HS.ImportDecl {HS.importSpecs = specs}) symbol = id {HS.importSpecs = specs & _Just . _2 %~ (++ [importSpec symbol])} - prettyPrint importDecl = - -- remove newlines from pretty printed ImportDecl - case lines $ HS.prettyPrint importDecl of - (fst : [] ) -> fst - (fst : rest) -> mconcat $ fst : (map (' ' :) . map (dropWhile (== ' ')) $ rest) - _ -> "" - importQualifiedModule :: String -> String -> HS.Module -> ImportChange importQualifiedModule moduleName qualifiedName module_ - | matching@(_:_) <- matchingImports moduleName module_ = + | matching@(_:_) <- matchingImports moduleName (importDecls module_) = if any (hasQualifiedImport qualifiedName) matching then NoImportChange - else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName) + else FindImportPos $ qualifiedImportDecl moduleName qualifiedName - | Just bestMatch <- bestMatchingImport moduleName module_ = - AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName) + | not $ null (importDecls module_) = + FindImportPos $ qualifiedImportDecl moduleName qualifiedName | otherwise = case srcLineForNewImport module_ of - Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName) - Nothing -> AddImportAtEnd (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName) - - -matchingImports :: String -> HS.Module -> [HS.ImportDecl] -matchingImports moduleName (HS.Module _ _ _ _ _ imports _) = - [ i - | i@HS.ImportDecl {HS.importModule = HS.ModuleName name} <- imports - , moduleName == name - ] - - -bestMatchingImport :: String -> HS.Module -> Maybe HS.ImportDecl -bestMatchingImport moduleName (HS.Module _ _ _ _ _ imports _) = - case ifoldl' computeMatches Nothing splittedMods of - Just (idx, _) -> Just $ imports !! idx - _ -> Nothing - where - computeMatches :: Int -> Maybe (Int, Int) -> [String] -> Maybe (Int, Int) - computeMatches idx matches mod = - let num' = numMatches splittedMod mod - in case matches of - Just (_, num) | num' >= num -> Just (idx, num') - | otherwise -> matches - - Nothing | num' > 0 -> Just (idx, num') - | otherwise -> Nothing - where - numMatches = loop 0 - where - loop num (a:as) (b:bs) - | a == b = loop (num + 1) as bs - | otherwise = num - - loop num [] _ = num - loop num _ [] = num - - splittedMod = splitOn "." moduleName - splittedMods = [ splitOn "." name - | HS.ImportDecl {HS.importModule = HS.ModuleName name} <- imports - ] + Just srcLine -> AddImportAfter srcLine (qualifiedImportDecl moduleName qualifiedName) + Nothing -> AddImportAtEnd (qualifiedImportDecl moduleName qualifiedName) entireModuleImported :: HS.ImportDecl -> Bool @@ -164,7 +118,7 @@ , any (imports symbol) hsSymbols = True - | otherwise + | otherwise = False where imports (Symbol symName) (HS.IVar name) = symName == nameString name @@ -241,40 +195,3 @@ = Just $ max 0 (HS.srcLine sLoc - 1) | otherwise = Nothing - - -srcLine :: HS.ImportDecl -> SrcLine -srcLine = HS.srcLine . HS.importLoc - - -declSrcLoc :: HS.Decl -> Maybe HS.SrcLoc -declSrcLoc decl = - case decl of - HS.TypeDecl srcLoc _ _ _ -> Just srcLoc - HS.TypeFamDecl srcLoc _ _ _ -> Just srcLoc - HS.DataDecl srcLoc _ _ _ _ _ _ -> Just srcLoc - HS.GDataDecl srcLoc _ _ _ _ _ _ _ -> Just srcLoc - HS.DataFamDecl srcLoc _ _ _ _ -> Just srcLoc - HS.TypeInsDecl srcLoc _ _ -> Just srcLoc - HS.DataInsDecl srcLoc _ _ _ _ -> Just srcLoc - HS.GDataInsDecl srcLoc _ _ _ _ _ -> Just srcLoc - HS.ClassDecl srcLoc _ _ _ _ _ -> Just srcLoc - HS.InstDecl srcLoc _ _ _ _ -> Just srcLoc - HS.DerivDecl srcLoc _ _ _ -> Just srcLoc - HS.InfixDecl srcLoc _ _ _ -> Just srcLoc - HS.DefaultDecl srcLoc _ -> Just srcLoc - HS.SpliceDecl srcLoc _ -> Just srcLoc - HS.TypeSig srcLoc _ _ -> Just srcLoc - HS.FunBind _ -> Nothing - HS.PatBind srcLoc _ _ _ _ -> Just srcLoc - HS.ForImp srcLoc _ _ _ _ _ -> Just srcLoc - HS.ForExp srcLoc _ _ _ _ -> Just srcLoc - HS.RulePragmaDecl srcLoc _ -> Just srcLoc - HS.DeprPragmaDecl srcLoc _ -> Just srcLoc - HS.WarnPragmaDecl srcLoc _ -> Just srcLoc - HS.InlineSig srcLoc _ _ _ -> Just srcLoc - HS.InlineConlikeSig srcLoc _ _ -> Just srcLoc - HS.SpecSig srcLoc _ _ _ -> Just srcLoc - HS.SpecInlineSig srcLoc _ _ _ _ -> Just srcLoc - HS.InstSig srcLoc _ _ _ -> Just srcLoc - HS.AnnPragma srcLoc _ -> Just srcLoc diff --git a/lib/HsImport/ImportPos.hs b/lib/HsImport/ImportPos.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/ImportPos.hs @@ -0,0 +1,71 @@ + +module HsImport.ImportPos + ( findImportPos + , ImportPos(..) + , matchingImports + , bestMatchingImport + ) where + +import qualified Language.Haskell.Exts as HS +import Data.List.Split (splitOn) +import Control.Lens +import Control.Applicative ((<$>)) + +type ModuleName = String + +-- | Where a new import declaration should be added. +data ImportPos = Before HS.ImportDecl -- ^ before the specified import declaration + | After HS.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 :: HS.ImportDecl -> [HS.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 -> [HS.ImportDecl] -> [HS.ImportDecl] +matchingImports moduleName imports = + [ i + | i@HS.ImportDecl {HS.importModule = HS.ModuleName name} <- imports + , moduleName == name + ] + + +-- | 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 -> [HS.ImportDecl] -> Maybe HS.ImportDecl +bestMatchingImport _ [] = Nothing +bestMatchingImport moduleName imports = + case ifoldl' computeMatches Nothing splittedMods of + Just (idx, _) -> Just $ imports !! idx + _ -> Nothing + where + computeMatches :: Int -> Maybe (Int, Int) -> [String] -> Maybe (Int, Int) + computeMatches idx matches mod = + let num' = numMatches splittedMod mod + in case matches of + Just (_, num) | num' >= num -> Just (idx, num') + | otherwise -> matches + + Nothing | num' > 0 -> Just (idx, num') + | otherwise -> Nothing + where + numMatches = loop 0 + where + loop num (a:as) (b:bs) + | a == b = loop (num + 1) as bs + | otherwise = num + + loop num [] _ = num + loop num _ [] = num + + splittedMod = splitOn "." moduleName + splittedMods = [ splitOn "." name + | HS.ImportDecl {HS.importModule = HS.ModuleName name} <- imports + ] diff --git a/lib/HsImport/Main.hs b/lib/HsImport/Main.hs --- a/lib/HsImport/Main.hs +++ b/lib/HsImport/Main.hs @@ -1,22 +1,50 @@ {-# Language PatternGuards #-} module HsImport.Main - ( hsImport + ( hsimport + , hsimport_ ) where import Control.Lens import Control.Applicative ((<$>)) import Control.Monad (when) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStrLn, stderr) import Data.Maybe (isJust) import Data.List (foldl') import qualified Data.Text as T import qualified Data.Text.IO as TIO +import qualified Config.Dyre as Dyre import HsImport.ImportChange import HsImport.ImportSpec +import HsImport.ImportPos (ImportPos(..)) +import qualified HsImport.Args as Args +import HsImport.Config +import HsImport.Utils +import qualified HsImport.Parse as P -hsImport :: ImportSpec -> IO () -hsImport spec = do +hsimport = Dyre.wrapMain $ Dyre.defaultParams + { Dyre.projectName = "hsimport" + , Dyre.realMain = realMain + , Dyre.showError = \config err -> config { configError = Just err } + } + where + realMain :: Config -> IO () + realMain config = do + case configError config of + Just error -> hPutStrLn stderr ("hsimport: " ++ error) >> exitFailure + _ -> return () + + args <- Args.hsImportArgs + maybeSpec <- hsImportSpec args + case maybeSpec of + Left error -> hPutStrLn stderr ("hsimport: " ++ error) >> exitFailure + Right spec -> hsimport_ config spec >> exitSuccess + + +hsimport_ :: Config -> ImportSpec -> IO () +hsimport_ Config { prettyPrint = prettyPrint, findImportPos = findImportPos } spec = do let impChanges = importChanges (spec ^. moduleToImport) (spec ^. symbolToImport) (spec ^. qualifiedName) @@ -30,21 +58,36 @@ where applyChanges = foldl' applyChange - applyChange srcLines (ReplaceImportAt srcLine importStr) = - let numDrops = srcLine - numTakes = max 0 (numDrops - 1) - in take numTakes srcLines ++ [importStr] ++ drop numDrops srcLines + applyChange srcLines (ReplaceImportAt srcLine importDecl) = + let numTakes = max 0 (srcLine - 1) + numDrops = lastImportSrcLine srcLine srcLines + in take numTakes srcLines ++ [prettyPrint importDecl] ++ drop numDrops srcLines - applyChange srcLines (AddImportAfter srcLine importStr) = - let numTakes = srcLine - numDrops = numTakes - in take numTakes srcLines ++ [importStr] ++ drop numDrops srcLines + applyChange srcLines (AddImportAfter srcLine importDecl) = + let numTakes = lastImportSrcLine srcLine srcLines + numDrops = numTakes + in take numTakes srcLines ++ [prettyPrint importDecl] ++ drop numDrops srcLines - applyChange srcLines (AddImportAtEnd importStr) = - srcLines ++ [importStr] + applyChange srcLines (AddImportAtEnd importDecl) = + srcLines ++ [prettyPrint importDecl] + applyChange srcLines (FindImportPos importDecl) = + case findImportPos importDecl allImportDecls of + Just (After impDecl) -> applyChange srcLines (AddImportAfter (srcLine impDecl) importDecl) + Just (Before impDecl) -> applyChange srcLines (AddImportAfter (max 0 (srcLine impDecl - 1)) importDecl) + _ -> applyChange srcLines (AddImportAfter (srcLine . last $ allImportDecls) importDecl) + applyChange srcLines NoImportChange = srcLines outputFile spec | Just file <- spec ^. saveToFile = file | otherwise = spec ^. sourceFile + + lastImportSrcLine fstLine srcLines + | Just lastLine <- P.lastImportSrcLine $ drop (max 0 (fstLine - 1)) srcLines + = fstLine + (lastLine - 1) + + | otherwise + = fstLine + + allImportDecls = importDecls $ spec ^. parsedSrcFile diff --git a/lib/HsImport/Parse.hs b/lib/HsImport/Parse.hs --- a/lib/HsImport/Parse.hs +++ b/lib/HsImport/Parse.hs @@ -2,6 +2,7 @@ module HsImport.Parse ( parseFile + , lastImportSrcLine ) where import qualified Data.Text.IO as TIO @@ -22,12 +23,12 @@ HS.ParseOk _ -> return $ Right result HS.ParseFailed srcLoc _ -> do - srcResult <- parseInvalidSource (lines srcFile) 0 (HS.srcLine srcLoc) + srcResult <- parseInvalidSource (lines srcFile) (HS.srcLine srcLoc) 0 (HS.srcLine srcLoc) return $ Right $ fromMaybe result srcResult) (\(e :: SomeException) -> do let srcLines = lines srcFile - srcResult <- parseInvalidSource srcLines 0 (length srcLines) + srcResult <- parseInvalidSource srcLines (length srcLines) 0 (length srcLines) return $ maybe (Left $ show e) Right srcResult) where -- | replace CPP directives by a fake comment @@ -37,25 +38,61 @@ else line +type SrcLine = Int + +-- | Expects that '[String]' starts with an import declaration and returns +-- the last source line of the import declaration, so this function +-- is for the handling of multine line import declarations. +lastImportSrcLine :: [String] -> Maybe SrcLine +lastImportSrcLine srcLines + | null srcLines + = Nothing + + | "import" `isPrefixOf` head srcLines + = parseImport 1 + + | otherwise + = Nothing + + where + parseImport lastLine + | lastLine <= numSrcLines + = case parseFileContents source of + HS.ParseOk _ -> Just lastLine + HS.ParseFailed _ _ -> parseImport (lastLine + 1) + + | otherwise + = Nothing + + where + source = unlines $ take lastLine srcLines + + numSrcLines = length srcLines + + -- | tries to find the maximal part of the source file (from the beginning) that contains -- valid/complete Haskell code -parseInvalidSource :: [String] -> Int -> Int -> IO (Maybe (HS.ParseResult HS.Module)) -parseInvalidSource srcLines lastValidLine firstInvalidLine - | null srcLines || lastValidLine >= firstInvalidLine = return Nothing +parseInvalidSource :: [String] -> Int -> Int -> Int -> IO (Maybe (HS.ParseResult HS.Module)) +parseInvalidSource srcLines firstInvalidLine lastValidLine currLastLine + | null srcLines || lastValidLine >= currLastLine = return Nothing | otherwise = catch (case parseFileContents source of result@(HS.ParseOk _) - | (nextLine + 1) == firstInvalidLine -> + | (nextLine + 1) == currLastLine -> return $ Just result - | otherwise -> - parseInvalidSource srcLines nextLine firstInvalidLine + | otherwise -> + parseInvalidSource srcLines firstInvalidLine nextLine currLastLine - HS.ParseFailed _ _ -> parseInvalidSource srcLines lastValidLine nextLine) + HS.ParseFailed srcLoc _ + | HS.srcLine srcLoc == firstInvalidLine -> + parseInvalidSource srcLines firstInvalidLine lastValidLine nextLine + | otherwise -> + parseInvalidSource srcLines firstInvalidLine nextLine currLastLine) - (\(_ :: SomeException) -> parseInvalidSource srcLines lastValidLine nextLine) + (\(_ :: SomeException) -> parseInvalidSource srcLines firstInvalidLine lastValidLine nextLine) where source = unlines $ take (nextLine + 1) srcLines - nextLine = lastValidLine + (floor ((realToFrac (firstInvalidLine - lastValidLine) / 2) :: Double) :: Int) + nextLine = lastValidLine + (floor ((realToFrac (currLastLine - lastValidLine) / 2) :: Double) :: Int) parseFileContents :: String -> HS.ParseResult HS.Module diff --git a/lib/HsImport/PrettyPrint.hs b/lib/HsImport/PrettyPrint.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/PrettyPrint.hs @@ -0,0 +1,16 @@ + +module HsImport.PrettyPrint + ( prettyPrint + ) where + +import Data.Monoid (mconcat) +import qualified Language.Haskell.Exts as HS + + +prettyPrint :: HS.ImportDecl -> String +prettyPrint importDecl = + -- remove newlines from pretty printed ImportDecl + case lines $ HS.prettyPrint importDecl of + (fst : [] ) -> fst + (fst : rest) -> mconcat $ fst : (map (' ' :) . map (dropWhile (== ' ')) $ rest) + _ -> "" diff --git a/lib/HsImport/Utils.hs b/lib/HsImport/Utils.hs new file mode 100644 --- /dev/null +++ b/lib/HsImport/Utils.hs @@ -0,0 +1,50 @@ + +module HsImport.Utils + ( srcLine + , declSrcLoc + , importDecls + ) where + +import qualified Language.Haskell.Exts as HS + +type SrcLine = Int + +srcLine :: HS.ImportDecl -> SrcLine +srcLine = HS.srcLine . HS.importLoc + + +declSrcLoc :: HS.Decl -> Maybe HS.SrcLoc +declSrcLoc decl = + case decl of + HS.TypeDecl srcLoc _ _ _ -> Just srcLoc + HS.TypeFamDecl srcLoc _ _ _ -> Just srcLoc + HS.DataDecl srcLoc _ _ _ _ _ _ -> Just srcLoc + HS.GDataDecl srcLoc _ _ _ _ _ _ _ -> Just srcLoc + HS.DataFamDecl srcLoc _ _ _ _ -> Just srcLoc + HS.TypeInsDecl srcLoc _ _ -> Just srcLoc + HS.DataInsDecl srcLoc _ _ _ _ -> Just srcLoc + HS.GDataInsDecl srcLoc _ _ _ _ _ -> Just srcLoc + HS.ClassDecl srcLoc _ _ _ _ _ -> Just srcLoc + HS.InstDecl srcLoc _ _ _ _ -> Just srcLoc + HS.DerivDecl srcLoc _ _ _ -> Just srcLoc + HS.InfixDecl srcLoc _ _ _ -> Just srcLoc + HS.DefaultDecl srcLoc _ -> Just srcLoc + HS.SpliceDecl srcLoc _ -> Just srcLoc + HS.TypeSig srcLoc _ _ -> Just srcLoc + HS.FunBind _ -> Nothing + HS.PatBind srcLoc _ _ _ _ -> Just srcLoc + HS.ForImp srcLoc _ _ _ _ _ -> Just srcLoc + HS.ForExp srcLoc _ _ _ _ -> Just srcLoc + HS.RulePragmaDecl srcLoc _ -> Just srcLoc + HS.DeprPragmaDecl srcLoc _ -> Just srcLoc + HS.WarnPragmaDecl srcLoc _ -> Just srcLoc + HS.InlineSig srcLoc _ _ _ -> Just srcLoc + HS.InlineConlikeSig srcLoc _ _ -> Just srcLoc + HS.SpecSig srcLoc _ _ _ -> Just srcLoc + HS.SpecInlineSig srcLoc _ _ _ _ -> Just srcLoc + HS.InstSig srcLoc _ _ _ -> Just srcLoc + HS.AnnPragma srcLoc _ -> Just srcLoc + + +importDecls :: HS.Module -> [HS.ImportDecl] +importDecls (HS.Module _ _ _ _ _ imports _) = imports diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -5,8 +5,13 @@ import Test.Tasty.Golden import System.FilePath import System.IO (hPutStrLn, stderr) -import HsImport (hsImport, hsImportSpec) +import Data.List (intercalate) +import qualified Language.Haskell.Exts as HS +import HsImport.Main (hsimport_) +import HsImport.ImportSpec (hsImportSpec) +import qualified HsImport.Config as C import qualified HsImport.Args as A +import qualified HsImport.ImportPos as P main = defaultMain tests @@ -42,6 +47,10 @@ , test "ModuleTest24" $ A.defaultArgs { A.moduleName = "Control.Monad", A.qualifiedName = "CM" } , test "ModuleTest25" $ A.defaultArgs { A.moduleName = "Control.Monad", A.qualifiedName = "Control.Monad" } , test "ModuleTest26" $ A.defaultArgs { A.moduleName = "Control.Monad" } + , test_ "ModuleTest27" (C.defaultConfig { C.findImportPos = importPosBeforeFirst }) (A.defaultArgs { A.moduleName = "Control.Monad" }) + , test_ "ModuleTest28" (C.defaultConfig { C.findImportPos = importPosAfterFirst }) (A.defaultArgs { A.moduleName = "Control.Monad" }) + , test_ "ModuleTest29" (C.defaultConfig { C.findImportPos = importPosBeforeLast }) (A.defaultArgs { A.moduleName = "Control.Monad" }) + , test_ "ModuleTest30" (C.defaultConfig { C.findImportPos = importPosAfterLast }) (A.defaultArgs { A.moduleName = "Control.Monad" }) ] @@ -73,21 +82,62 @@ , test "SymbolTest23" $ A.defaultArgs { A.moduleName = "Data.Maybe", A.symbolName = "Maybe", A.all = True, A.with = ["Just"] } , test "SymbolTest24" $ A.defaultArgs { A.moduleName = "Data.Maybe", A.symbolName = "Maybe", A.with = ["Just"] } , test "SymbolTest25" $ A.defaultArgs { A.moduleName = "Data.Maybe", A.symbolName = "Maybe", A.with = ["Nothing", "Just"] } + , test "SymbolTest26" $ A.defaultArgs { A.moduleName = "Foo", A.symbolName = "bar" } + , test "SymbolTest27" $ A.defaultArgs { A.moduleName = "Ugah.Blub", A.symbolName = "g" } + , test "SymbolTest28" $ A.defaultArgs { A.moduleName = "Ugah.Blub", A.symbolName = "d" } + , test_ "SymbolTest29" (C.defaultConfig { C.prettyPrint = prettyPrint }) (A.defaultArgs { A.moduleName = "X.Y", A.symbolName = "x" }) ] test :: String -> A.HsImportArgs -> TestTree -test testName args = +test testName args = test_ testName C.defaultConfig args + + +test_ :: String -> C.Config -> A.HsImportArgs -> TestTree +test_ testName config args = goldenVsFileDiff testName diff goldenFile outputFile command where command = do spec <- hsImportSpec (args { A.inputSrcFile = inputFile, A.outputSrcFile = outputFile }) case spec of Left error -> hPutStrLn stderr ("hsimport: " ++ error) - Right spec_ -> hsImport spec_ + Right spec_ -> hsimport_ config spec_ diff ref new = ["diff", "-u", ref, new] goldenFile = "tests" "goldenFiles" testName <.> "hs" outputFile = "tests" "outputFiles" testName <.> "hs" inputFile = "tests" "inputFiles" testName <.> "hs" + + +prettyPrint :: HS.ImportDecl -> String +prettyPrint HS.ImportDecl { HS.importModule = HS.ModuleName modName, HS.importSpecs = Just (False, syms) } = + "import " ++ modName ++ " ( " ++ ppSyms ++ " )" + where + ppSyms = intercalate " , " symNames + symNames = map symName syms + + symName (HS.IVar (HS.Ident name)) = name + symName _ = "" + +prettyPrint _ = "Uupps" + + +importPosAfterLast :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe P.ImportPos +importPosAfterLast _ [] = Nothing +importPosAfterLast _ imports = Just . P.After . last $ imports + + +importPosBeforeLast :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe P.ImportPos +importPosBeforeLast _ [] = Nothing +importPosBeforeLast _ imports = Just . P.Before . last $ imports + + +importPosAfterFirst :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe P.ImportPos +importPosAfterFirst _ [] = Nothing +importPosAfterFirst _ imports = Just . P.After . head $ imports + + +importPosBeforeFirst :: HS.ImportDecl -> [HS.ImportDecl] -> Maybe P.ImportPos +importPosBeforeFirst _ [] = Nothing +importPosBeforeFirst _ imports = Just . P.Before . head $ imports diff --git a/tests/goldenFiles/ModuleTest27.hs b/tests/goldenFiles/ModuleTest27.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest27.hs @@ -0,0 +1,18 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Monad +import Ugah.Foo ( a + , b + ) +import Control.Applicative +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest28.hs b/tests/goldenFiles/ModuleTest28.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest28.hs @@ -0,0 +1,18 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo ( a + , b + ) +import Control.Monad +import Control.Applicative +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest29.hs b/tests/goldenFiles/ModuleTest29.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest29.hs @@ -0,0 +1,18 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative ( a + , b + ) +import Control.Monad +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/ModuleTest30.hs b/tests/goldenFiles/ModuleTest30.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/ModuleTest30.hs @@ -0,0 +1,18 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative +import Ugah.Blub ( a + , b + ) +import Control.Monad +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/goldenFiles/SymbolTest26.hs b/tests/goldenFiles/SymbolTest26.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/SymbolTest26.hs @@ -0,0 +1,3 @@ +import Foo (foo, bar) +boo :: Int +boo = 3 diff --git a/tests/goldenFiles/SymbolTest27.hs b/tests/goldenFiles/SymbolTest27.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/SymbolTest27.hs @@ -0,0 +1,15 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative +import Ugah.Blub (a, b, c, d, e, f, g) +f :: Int -> Int +f = (+ 3) + +g :: Int +g = + where diff --git a/tests/goldenFiles/SymbolTest28.hs b/tests/goldenFiles/SymbolTest28.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/SymbolTest28.hs @@ -0,0 +1,13 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Applicative +import Ugah.Blub (a, b, c, d) +f :: Int -> Int +f = (+ 3) + +r :: Int -> Int +r = diff --git a/tests/goldenFiles/SymbolTest29.hs b/tests/goldenFiles/SymbolTest29.hs new file mode 100644 --- /dev/null +++ b/tests/goldenFiles/SymbolTest29.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Applicative +import Ugah.Blub ( a + , b + , c + ) +import X.Y ( x ) +f :: Int -> Int +f = (+ 3) + +r :: Int -> Int +r = diff --git a/tests/inputFiles/ModuleTest27.hs b/tests/inputFiles/ModuleTest27.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest27.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo ( a + , b + ) +import Control.Applicative +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest28.hs b/tests/inputFiles/ModuleTest28.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest28.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo ( a + , b + ) +import Control.Applicative +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest29.hs b/tests/inputFiles/ModuleTest29.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest29.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative ( a + , b + ) +import Ugah.Blub +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/ModuleTest30.hs b/tests/inputFiles/ModuleTest30.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/ModuleTest30.hs @@ -0,0 +1,17 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative +import Ugah.Blub ( a + , b + ) +f :: Int -> Int +f = (+ 3) + +g :: Int -> Int +g = + where diff --git a/tests/inputFiles/SymbolTest26.hs b/tests/inputFiles/SymbolTest26.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/SymbolTest26.hs @@ -0,0 +1,3 @@ +import Foo (foo) +boo :: Int +boo = 3 diff --git a/tests/inputFiles/SymbolTest27.hs b/tests/inputFiles/SymbolTest27.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/SymbolTest27.hs @@ -0,0 +1,16 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Ugah.Foo +import Control.Applicative +import Ugah.Blub (a, b, c, + d, e, f) +f :: Int -> Int +f = (+ 3) + +g :: Int +g = + where diff --git a/tests/inputFiles/SymbolTest28.hs b/tests/inputFiles/SymbolTest28.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/SymbolTest28.hs @@ -0,0 +1,16 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Applicative +import Ugah.Blub ( a + , b + , c + ) +f :: Int -> Int +f = (+ 3) + +r :: Int -> Int +r = diff --git a/tests/inputFiles/SymbolTest29.hs b/tests/inputFiles/SymbolTest29.hs new file mode 100644 --- /dev/null +++ b/tests/inputFiles/SymbolTest29.hs @@ -0,0 +1,16 @@ +{-# Language PatternGuards #-} +module Blub + ( blub + , foo + , bar + ) where +import Control.Applicative +import Ugah.Blub ( a + , b + , c + ) +f :: Int -> Int +f = (+ 3) + +r :: Int -> Int +r =