hsimport 0.2.10 → 0.2.11
raw patch · 15 files changed
+517/−522 lines, 15 filesdep ~lens
Dependency ranges changed: lens
Files
- exe/Main.hs +14/−0
- hsimport.cabal +7/−12
- lib/HsImport.hs +11/−0
- lib/HsImport/Args.hs +47/−0
- lib/HsImport/ImportChange.hs +257/−0
- lib/HsImport/ImportSpec.hs +67/−0
- lib/HsImport/Main.hs +50/−0
- lib/HsImport/Parse.hs +64/−0
- src/HsImport.hs +0/−11
- src/HsImport/Args.hs +0/−47
- src/HsImport/ImportChange.hs +0/−257
- src/HsImport/ImportSpec.hs +0/−67
- src/HsImport/Main.hs +0/−50
- src/HsImport/Parse.hs +0/−64
- src/Main.hs +0/−14
+ exe/Main.hs view
@@ -0,0 +1,14 @@++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
hsimport.cabal view
@@ -1,5 +1,5 @@ name: hsimport-version: 0.2.10+version: 0.2.11 cabal-version: >=1.9.2 build-type: Simple license: BSD3@@ -19,7 +19,7 @@ library build-depends: base >=3 && <5, cmdargs >=0.10.5 && <0.11,- haskell-src-exts >=1.14.0 && <1.15, lens >=3.9.2 && <4.1,+ haskell-src-exts >=1.14.0 && <1.15, lens >=3.9.2 && <4.2, mtl >=2.1.2 && <2.2, text >=0.11.3.1 && <1.2, split >=0.2.2 && <0.3, attoparsec >=0.10.4.0 && <0.12, directory >=1.2.0.1 && <1.3@@ -28,22 +28,16 @@ exposed: True buildable: True cpp-options: -DCABAL- hs-source-dirs: src+ hs-source-dirs: lib other-modules: HsImport.ImportChange HsImport.Parse Paths_hsimport ghc-options: -W executable hsimport- build-depends: base >=3 && <5, cmdargs >=0.10.5 && <0.11,- haskell-src-exts >=1.14.0 && <1.15, lens >=3.9.2 && <4.1,- mtl >=2.1.2 && <2.2, text >=0.11.3.1 && <1.2,- split >=0.2.2 && <0.3, attoparsec >=0.10.4.0 && <0.12,- directory >=1.2.0.1 && <1.3+ build-depends: base >=3 && <5, hsimport -any main-is: Main.hs buildable: True cpp-options: -DCABAL- hs-source-dirs: src- other-modules: HsImport HsImport.Args HsImport.ImportSpec- HsImport.ImportChange HsImport.Parse HsImport.Main Paths_hsimport+ hs-source-dirs: exe ghc-options: -W test-suite hsimport-tests@@ -51,7 +45,8 @@ tasty-golden >=2.2.0.1 && <2.3, filepath >=1.3.0.1 && <1.4, hsimport -any type: exitcode-stdio-1.0- main-is: tests/Main.hs+ hs-source-dirs: tests+ main-is: Main.hs buildable: True ghc-options: -W
+ lib/HsImport.hs view
@@ -0,0 +1,11 @@++module HsImport+ ( HsImportArgs+ , hsImportArgs+ , module HsImport.ImportSpec+ , module HsImport.Main+ ) where++import HsImport.Args+import HsImport.ImportSpec+import HsImport.Main
+ lib/HsImport/Args.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}++module HsImport.Args+ ( HsImportArgs(..)+ , hsImportArgs+ ) where++import System.Console.CmdArgs++#ifdef CABAL+import Data.Version (showVersion)+import Paths_hsimport (version)+#endif++data HsImportArgs = HsImportArgs+ { moduleName :: String+ , symbolName :: String+ , qualifiedName :: String+ , inputSrcFile :: FilePath+ , outputSrcFile :: FilePath+ } deriving (Data, Typeable, Show, Eq)+++hsImportArgs :: IO HsImportArgs+hsImportArgs = cmdArgs $ HsImportArgs + { moduleName = def &= help "The module to import"+ , symbolName = def &= help "The symbol to import, if empty, the entire module is imported"+ , qualifiedName = def &= help "The name to use for a qualified module import"+ , outputSrcFile = def &= help "Save modified source file to file, if empty, the source file is modified inplace" &= typFile+ , inputSrcFile = def &= args &= typ "SOURCEFILE"+ }+ &= program "hsimport"+ &= summary summaryInfo+ &= help "A command line program for extending the import list of a Haskell source file."+ &= helpArg [explicit, name "help", name "h"]+ &= versionArg [explicit, name "version", name "v", summary versionInfo]+ where+ summaryInfo = ""+++versionInfo :: String+versionInfo =+#ifdef CABAL+ "hsimport version " ++ showVersion version+#else+ "hsimport version unknown (not built with cabal)"+#endif
+ lib/HsImport/ImportChange.hs view
@@ -0,0 +1,257 @@+{-# Language PatternGuards #-}++module HsImport.ImportChange+ ( ImportChange(..)+ , importChanges+ ) where++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++type SrcLine = Int+type ImportString = String++data ImportChange = ReplaceImportAt SrcLine ImportString+ | AddImportAfter SrcLine ImportString+ | AddImportAtEnd ImportString+ | NoImportChange+ deriving (Show)+++importChanges :: String -> Maybe String -> Maybe String -> HS.Module -> [ImportChange]+importChanges moduleName (Just symbolName) (Just qualifiedName) module_ =+ [ importModuleWithSymbol moduleName symbolName module_+ , importQualifiedModule moduleName qualifiedName module_+ ]++importChanges moduleName (Just symbolName) Nothing module_ =+ [ importModuleWithSymbol moduleName symbolName module_ ]++importChanges moduleName Nothing (Just qualifiedName) module_ =+ [ importQualifiedModule moduleName qualifiedName module_ ]++importChanges moduleName Nothing Nothing module_ =+ [ importModule moduleName module_ ]+++importModule :: String -> HS.Module -> ImportChange+importModule moduleName module_+ | matching@(_:_) <- matchingImports moduleName module_ =+ if any entireModuleImported matching+ then NoImportChange+ else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ importDecl moduleName)++ | Just bestMatch <- bestMatchingImport moduleName module_ =+ AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ importDecl moduleName)++ | otherwise =+ case srcLineForNewImport module_ of+ Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ importDecl moduleName)+ Nothing -> AddImportAtEnd (HS.prettyPrint $ importDecl moduleName)+++importModuleWithSymbol :: String -> String -> HS.Module -> ImportChange+importModuleWithSymbol moduleName symbolName module_+ | matching@(_:_) <- matchingImports moduleName module_ =+ if any entireModuleImported matching || any (symbolImported symbolName) matching+ then NoImportChange+ else case find hasImportedSymbols matching of+ Just impDecl ->+ ReplaceImportAt (srcLine impDecl) (HS.prettyPrint $ addSymbol impDecl symbolName)++ Nothing ->+ AddImportAfter (srcLine . last $ matching)+ (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)++ | Just bestMatch <- bestMatchingImport moduleName module_ =+ AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)++ | otherwise =+ case srcLineForNewImport module_ of+ Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)+ Nothing -> AddImportAtEnd (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)+ where+ addSymbol (id@HS.ImportDecl {HS.importSpecs = specs}) symbolName =+ id {HS.importSpecs = specs & _Just . _2 %~ (++ [HS.IVar $ hsName symbolName])}+++importQualifiedModule :: String -> String -> HS.Module -> ImportChange+importQualifiedModule moduleName qualifiedName module_+ | matching@(_:_) <- matchingImports moduleName module_ =+ if any (hasQualifiedImport qualifiedName) matching+ then NoImportChange+ else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName)++ | Just bestMatch <- bestMatchingImport moduleName module_ =+ AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ 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+ ] +++entireModuleImported :: HS.ImportDecl -> Bool+entireModuleImported import_ =+ not (HS.importQualified import_) && isNothing (HS.importSpecs import_)+++hasQualifiedImport :: String -> HS.ImportDecl -> Bool+hasQualifiedImport qualifiedName import_+ | HS.importQualified import_+ , Just (HS.ModuleName importAs) <- HS.importAs import_+ , importAs == qualifiedName+ = True++ | otherwise = False+++symbolImported :: String -> HS.ImportDecl -> Bool+symbolImported symbol import_+ | Just (False, symbols) <- HS.importSpecs import_+ , any (== symbol) (symbolStrings symbols)+ = True++ | otherwise = False+ where+ symbolStrings = map symbolString++ symbolString (HS.IVar name) = nameString name+ symbolString (HS.IAbs name) = nameString name+ symbolString (HS.IThingAll name) = nameString name+ symbolString (HS.IThingWith name _) = nameString name++ nameString (HS.Ident id) = id+ nameString (HS.Symbol sym) = sym+++hasImportedSymbols :: HS.ImportDecl -> Bool+hasImportedSymbols import_+ | Just (False, _:_) <- HS.importSpecs import_ = True+ | otherwise = False+++importDecl :: String -> HS.ImportDecl+importDecl moduleName = HS.ImportDecl+ { HS.importLoc = HS.SrcLoc "" 0 0+ , HS.importModule = HS.ModuleName moduleName+ , HS.importQualified = False+ , HS.importSrc = False+ , HS.importPkg = Nothing+ , HS.importAs = Nothing+ , HS.importSpecs = Nothing+ }+++importDeclWithSymbol :: String -> String -> HS.ImportDecl+importDeclWithSymbol moduleName symbolName =+ (importDecl moduleName) { HS.importSpecs = Just (False, [HS.IVar $ hsName symbolName]) }+++qualifiedImportDecl :: String -> String -> HS.ImportDecl+qualifiedImportDecl moduleName qualifiedName =+ (importDecl moduleName) { HS.importQualified = True+ , HS.importAs = if moduleName /= qualifiedName+ then Just $ HS.ModuleName qualifiedName+ else Nothing+ }+++hsName :: String -> HS.Name+hsName symbolName+ | isSymbol = HS.Symbol symbolName+ | otherwise = HS.Ident symbolName+ where+ isSymbol = any (A.notInClass "a-zA-Z0-9_'") symbolName+++srcLineForNewImport :: HS.Module -> Maybe SrcLine+srcLineForNewImport (HS.Module modSrcLoc _ _ _ _ imports decls)+ | not $ null imports = Just (srcLine $ last imports)++ | (decl:_) <- decls+ , Just sLoc <- declSrcLoc decl+ , HS.srcLine sLoc >= HS.srcLine modSrcLoc+ = 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
+ lib/HsImport/ImportSpec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell, PatternGuards #-}++module HsImport.ImportSpec+ ( ImportSpec(..)+ , sourceFile+ , parsedSrcFile+ , moduleToImport+ , symbolToImport+ , qualifiedName+ , saveToFile+ , hsImportSpec+ ) where++import Control.Lens+import qualified Language.Haskell.Exts as HS+import qualified HsImport.Args as Args+import HsImport.Args (HsImportArgs)+import HsImport.Parse (parseFile)++data ImportSpec = ImportSpec + { _sourceFile :: FilePath+ , _parsedSrcFile :: HS.Module+ , _moduleToImport :: String+ , _symbolToImport :: Maybe String+ , _qualifiedName :: Maybe String+ , _saveToFile :: Maybe FilePath+ } deriving (Show) ++makeLenses ''ImportSpec+++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 modul) -> return $ Right $+ ImportSpec (Args.inputSrcFile args) modul+ (Args.moduleName args) symbolName+ qualifiedName saveToFile++ Right (HS.ParseFailed srcLoc error) -> return $ Left (show srcLoc ++ error)++ Left error -> return $ Left error++ where+ symbolName =+ case Args.symbolName args of+ "" -> Nothing+ sym -> Just sym++ qualifiedName =+ case Args.qualifiedName args of+ "" -> Nothing+ qn -> Just qn++ 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!"+ | otherwise = Nothing
+ lib/HsImport/Main.hs view
@@ -0,0 +1,50 @@+{-# Language PatternGuards #-}++module HsImport.Main+ ( hsImport+ ) where++import Control.Lens+import Control.Applicative ((<$>))+import Control.Monad (when)+import Data.Maybe (isJust)+import Data.List (foldl')+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import HsImport.ImportChange+import HsImport.ImportSpec+++hsImport :: ImportSpec -> IO ()+hsImport spec = do+ let impChanges = importChanges (spec ^. moduleToImport)+ (spec ^. symbolToImport)+ (spec ^. qualifiedName)+ (spec ^. parsedSrcFile)++ srcLines <- lines . T.unpack <$> TIO.readFile (spec ^. sourceFile)+ let srcLines' = applyChanges srcLines impChanges+ when (srcLines' /= srcLines || isJust (spec ^. saveToFile)) $+ TIO.writeFile (outputFile spec) (T.pack $ unlines srcLines')++ 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 (AddImportAfter srcLine importStr) =+ let numTakes = srcLine+ numDrops = numTakes+ in take numTakes srcLines ++ [importStr] ++ drop numDrops srcLines++ applyChange srcLines (AddImportAtEnd importStr) =+ srcLines ++ [importStr]++ applyChange srcLines NoImportChange = srcLines++ outputFile spec+ | Just file <- spec ^. saveToFile = file+ | otherwise = spec ^. sourceFile
+ lib/HsImport/Parse.hs view
@@ -0,0 +1,64 @@+{-# Language ScopedTypeVariables #-}++module HsImport.Parse+ ( parseFile+ ) where++import qualified Data.Text.IO as TIO+import qualified Data.Text as T+import Data.Maybe (fromMaybe)+import Data.List (isPrefixOf)+import qualified Language.Haskell.Exts as HS+import Control.Applicative ((<$>))+import Control.Exception (catch, SomeException)++type Error = String++parseFile :: FilePath -> IO (Either Error (HS.ParseResult HS.Module))+parseFile file = do+ srcFile <- unlines. replaceCPPByComment . lines . T.unpack <$> TIO.readFile file+ catch (do let result = parseFileContents srcFile+ case result of+ HS.ParseOk _ -> return $ Right result++ HS.ParseFailed srcLoc _ -> do+ srcResult <- parseInvalidSource (lines srcFile) 0 (HS.srcLine srcLoc)+ return $ Right $ fromMaybe result srcResult)++ (\(e :: SomeException) -> do+ let srcLines = lines srcFile+ srcResult <- parseInvalidSource srcLines 0 (length srcLines)+ return $ maybe (Left $ show e) Right srcResult)+ where+ -- | replace CPP directives by a fake comment+ replaceCPPByComment = map $ \line ->+ if "#" `isPrefixOf` line+ then "-- fake hsimport comment"+ else line+++-- | 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+ | otherwise =+ catch (case parseFileContents source of+ result@(HS.ParseOk _)+ | (nextLine + 1) == firstInvalidLine ->+ return $ Just result+ | otherwise ->+ parseInvalidSource srcLines nextLine firstInvalidLine++ HS.ParseFailed _ _ -> parseInvalidSource srcLines lastValidLine nextLine)++ (\(_ :: SomeException) -> parseInvalidSource srcLines lastValidLine nextLine)+ where+ source = unlines $ take (nextLine + 1) srcLines+ nextLine = lastValidLine + (floor ((realToFrac (firstInvalidLine - lastValidLine) / 2) :: Double) :: Int)+++parseFileContents :: String -> HS.ParseResult HS.Module+parseFileContents = HS.parseFileContentsWithMode parseMode+ where+ parseMode = HS.defaultParseMode { HS.fixities = Just [] }
− src/HsImport.hs
@@ -1,11 +0,0 @@--module HsImport- ( HsImportArgs- , hsImportArgs- , module HsImport.ImportSpec- , module HsImport.Main- ) where--import HsImport.Args-import HsImport.ImportSpec-import HsImport.Main
− src/HsImport/Args.hs
@@ -1,47 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, CPP #-}--module HsImport.Args- ( HsImportArgs(..)- , hsImportArgs- ) where--import System.Console.CmdArgs--#ifdef CABAL-import Data.Version (showVersion)-import Paths_hsimport (version)-#endif--data HsImportArgs = HsImportArgs- { moduleName :: String- , symbolName :: String- , qualifiedName :: String- , inputSrcFile :: FilePath- , outputSrcFile :: FilePath- } deriving (Data, Typeable, Show, Eq)---hsImportArgs :: IO HsImportArgs-hsImportArgs = cmdArgs $ HsImportArgs - { moduleName = def &= help "The module to import"- , symbolName = def &= help "The symbol to import, if empty, the entire module is imported"- , qualifiedName = def &= help "The name to use for a qualified module import"- , outputSrcFile = def &= help "Save modified source file to file, if empty, the source file is modified inplace" &= typFile- , inputSrcFile = def &= args &= typ "SOURCEFILE"- }- &= program "hsimport"- &= summary summaryInfo- &= help "A command line program for extending the import list of a Haskell source file."- &= helpArg [explicit, name "help", name "h"]- &= versionArg [explicit, name "version", name "v", summary versionInfo]- where- summaryInfo = ""---versionInfo :: String-versionInfo =-#ifdef CABAL- "hsimport version " ++ showVersion version-#else- "hsimport version unknown (not built with cabal)"-#endif
− src/HsImport/ImportChange.hs
@@ -1,257 +0,0 @@-{-# Language PatternGuards #-}--module HsImport.ImportChange- ( ImportChange(..)- , importChanges- ) where--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--type SrcLine = Int-type ImportString = String--data ImportChange = ReplaceImportAt SrcLine ImportString- | AddImportAfter SrcLine ImportString- | AddImportAtEnd ImportString- | NoImportChange- deriving (Show)---importChanges :: String -> Maybe String -> Maybe String -> HS.Module -> [ImportChange]-importChanges moduleName (Just symbolName) (Just qualifiedName) module_ =- [ importModuleWithSymbol moduleName symbolName module_- , importQualifiedModule moduleName qualifiedName module_- ]--importChanges moduleName (Just symbolName) Nothing module_ =- [ importModuleWithSymbol moduleName symbolName module_ ]--importChanges moduleName Nothing (Just qualifiedName) module_ =- [ importQualifiedModule moduleName qualifiedName module_ ]--importChanges moduleName Nothing Nothing module_ =- [ importModule moduleName module_ ]---importModule :: String -> HS.Module -> ImportChange-importModule moduleName module_- | matching@(_:_) <- matchingImports moduleName module_ =- if any entireModuleImported matching- then NoImportChange- else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ importDecl moduleName)-- | Just bestMatch <- bestMatchingImport moduleName module_ =- AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ importDecl moduleName)-- | otherwise =- case srcLineForNewImport module_ of- Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ importDecl moduleName)- Nothing -> AddImportAtEnd (HS.prettyPrint $ importDecl moduleName)---importModuleWithSymbol :: String -> String -> HS.Module -> ImportChange-importModuleWithSymbol moduleName symbolName module_- | matching@(_:_) <- matchingImports moduleName module_ =- if any entireModuleImported matching || any (symbolImported symbolName) matching- then NoImportChange- else case find hasImportedSymbols matching of- Just impDecl ->- ReplaceImportAt (srcLine impDecl) (HS.prettyPrint $ addSymbol impDecl symbolName)-- Nothing ->- AddImportAfter (srcLine . last $ matching)- (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)-- | Just bestMatch <- bestMatchingImport moduleName module_ =- AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)-- | otherwise =- case srcLineForNewImport module_ of- Just srcLine -> AddImportAfter srcLine (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)- Nothing -> AddImportAtEnd (HS.prettyPrint $ importDeclWithSymbol moduleName symbolName)- where- addSymbol (id@HS.ImportDecl {HS.importSpecs = specs}) symbolName =- id {HS.importSpecs = specs & _Just . _2 %~ (++ [HS.IVar $ hsName symbolName])}---importQualifiedModule :: String -> String -> HS.Module -> ImportChange-importQualifiedModule moduleName qualifiedName module_- | matching@(_:_) <- matchingImports moduleName module_ =- if any (hasQualifiedImport qualifiedName) matching- then NoImportChange- else AddImportAfter (srcLine . last $ matching) (HS.prettyPrint $ qualifiedImportDecl moduleName qualifiedName)-- | Just bestMatch <- bestMatchingImport moduleName module_ =- AddImportAfter (srcLine bestMatch) (HS.prettyPrint $ 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- ] ---entireModuleImported :: HS.ImportDecl -> Bool-entireModuleImported import_ =- not (HS.importQualified import_) && isNothing (HS.importSpecs import_)---hasQualifiedImport :: String -> HS.ImportDecl -> Bool-hasQualifiedImport qualifiedName import_- | HS.importQualified import_- , Just (HS.ModuleName importAs) <- HS.importAs import_- , importAs == qualifiedName- = True-- | otherwise = False---symbolImported :: String -> HS.ImportDecl -> Bool-symbolImported symbol import_- | Just (False, symbols) <- HS.importSpecs import_- , any (== symbol) (symbolStrings symbols)- = True-- | otherwise = False- where- symbolStrings = map symbolString-- symbolString (HS.IVar name) = nameString name- symbolString (HS.IAbs name) = nameString name- symbolString (HS.IThingAll name) = nameString name- symbolString (HS.IThingWith name _) = nameString name-- nameString (HS.Ident id) = id- nameString (HS.Symbol sym) = sym---hasImportedSymbols :: HS.ImportDecl -> Bool-hasImportedSymbols import_- | Just (False, _:_) <- HS.importSpecs import_ = True- | otherwise = False---importDecl :: String -> HS.ImportDecl-importDecl moduleName = HS.ImportDecl- { HS.importLoc = HS.SrcLoc "" 0 0- , HS.importModule = HS.ModuleName moduleName- , HS.importQualified = False- , HS.importSrc = False- , HS.importPkg = Nothing- , HS.importAs = Nothing- , HS.importSpecs = Nothing- }---importDeclWithSymbol :: String -> String -> HS.ImportDecl-importDeclWithSymbol moduleName symbolName =- (importDecl moduleName) { HS.importSpecs = Just (False, [HS.IVar $ hsName symbolName]) }---qualifiedImportDecl :: String -> String -> HS.ImportDecl-qualifiedImportDecl moduleName qualifiedName =- (importDecl moduleName) { HS.importQualified = True- , HS.importAs = if moduleName /= qualifiedName- then Just $ HS.ModuleName qualifiedName- else Nothing- }---hsName :: String -> HS.Name-hsName symbolName- | isSymbol = HS.Symbol symbolName- | otherwise = HS.Ident symbolName- where- isSymbol = any (A.notInClass "a-zA-Z0-9_'") symbolName---srcLineForNewImport :: HS.Module -> Maybe SrcLine-srcLineForNewImport (HS.Module modSrcLoc _ _ _ _ imports decls)- | not $ null imports = Just (srcLine $ last imports)-- | (decl:_) <- decls- , Just sLoc <- declSrcLoc decl- , HS.srcLine sLoc >= HS.srcLine modSrcLoc- = 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
− src/HsImport/ImportSpec.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE TemplateHaskell, PatternGuards #-}--module HsImport.ImportSpec- ( ImportSpec(..)- , sourceFile- , parsedSrcFile- , moduleToImport- , symbolToImport- , qualifiedName- , saveToFile- , hsImportSpec- ) where--import Control.Lens-import qualified Language.Haskell.Exts as HS-import qualified HsImport.Args as Args-import HsImport.Args (HsImportArgs)-import HsImport.Parse (parseFile)--data ImportSpec = ImportSpec - { _sourceFile :: FilePath- , _parsedSrcFile :: HS.Module- , _moduleToImport :: String- , _symbolToImport :: Maybe String- , _qualifiedName :: Maybe String- , _saveToFile :: Maybe FilePath- } deriving (Show) --makeLenses ''ImportSpec---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 modul) -> return $ Right $- ImportSpec (Args.inputSrcFile args) modul- (Args.moduleName args) symbolName- qualifiedName saveToFile-- Right (HS.ParseFailed srcLoc error) -> return $ Left (show srcLoc ++ error)-- Left error -> return $ Left error-- where- symbolName =- case Args.symbolName args of- "" -> Nothing- sym -> Just sym-- qualifiedName =- case Args.qualifiedName args of- "" -> Nothing- qn -> Just qn-- 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!"- | otherwise = Nothing
− src/HsImport/Main.hs
@@ -1,50 +0,0 @@-{-# Language PatternGuards #-}--module HsImport.Main- ( hsImport- ) where--import Control.Lens-import Control.Applicative ((<$>))-import Control.Monad (when)-import Data.Maybe (isJust)-import Data.List (foldl')-import qualified Data.Text as T-import qualified Data.Text.IO as TIO-import HsImport.ImportChange-import HsImport.ImportSpec---hsImport :: ImportSpec -> IO ()-hsImport spec = do- let impChanges = importChanges (spec ^. moduleToImport)- (spec ^. symbolToImport)- (spec ^. qualifiedName)- (spec ^. parsedSrcFile)-- srcLines <- lines . T.unpack <$> TIO.readFile (spec ^. sourceFile)- let srcLines' = applyChanges srcLines impChanges- when (srcLines' /= srcLines || isJust (spec ^. saveToFile)) $- TIO.writeFile (outputFile spec) (T.pack $ unlines srcLines')-- 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 (AddImportAfter srcLine importStr) =- let numTakes = srcLine- numDrops = numTakes- in take numTakes srcLines ++ [importStr] ++ drop numDrops srcLines-- applyChange srcLines (AddImportAtEnd importStr) =- srcLines ++ [importStr]-- applyChange srcLines NoImportChange = srcLines-- outputFile spec- | Just file <- spec ^. saveToFile = file- | otherwise = spec ^. sourceFile
− src/HsImport/Parse.hs
@@ -1,64 +0,0 @@-{-# Language ScopedTypeVariables #-}--module HsImport.Parse- ( parseFile- ) where--import qualified Data.Text.IO as TIO-import qualified Data.Text as T-import Data.Maybe (fromMaybe)-import Data.List (isPrefixOf)-import qualified Language.Haskell.Exts as HS-import Control.Applicative ((<$>))-import Control.Exception (catch, SomeException)--type Error = String--parseFile :: FilePath -> IO (Either Error (HS.ParseResult HS.Module))-parseFile file = do- srcFile <- unlines. replaceCPPByComment . lines . T.unpack <$> TIO.readFile file- catch (do let result = parseFileContents srcFile- case result of- HS.ParseOk _ -> return $ Right result-- HS.ParseFailed srcLoc _ -> do- srcResult <- parseInvalidSource (lines srcFile) 0 (HS.srcLine srcLoc)- return $ Right $ fromMaybe result srcResult)-- (\(e :: SomeException) -> do- let srcLines = lines srcFile- srcResult <- parseInvalidSource srcLines 0 (length srcLines)- return $ maybe (Left $ show e) Right srcResult)- where- -- | replace CPP directives by a fake comment- replaceCPPByComment = map $ \line ->- if "#" `isPrefixOf` line- then "-- fake hsimport comment"- else line----- | 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- | otherwise =- catch (case parseFileContents source of- result@(HS.ParseOk _)- | (nextLine + 1) == firstInvalidLine ->- return $ Just result- | otherwise ->- parseInvalidSource srcLines nextLine firstInvalidLine-- HS.ParseFailed _ _ -> parseInvalidSource srcLines lastValidLine nextLine)-- (\(_ :: SomeException) -> parseInvalidSource srcLines lastValidLine nextLine)- where- source = unlines $ take (nextLine + 1) srcLines- nextLine = lastValidLine + (floor ((realToFrac (firstInvalidLine - lastValidLine) / 2) :: Double) :: Int)---parseFileContents :: String -> HS.ParseResult HS.Module-parseFileContents = HS.parseFileContentsWithMode parseMode- where- parseMode = HS.defaultParseMode { HS.fixities = Just [] }
− src/Main.hs
@@ -1,14 +0,0 @@--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