hsimport 0.2 → 0.2.1
raw patch · 5 files changed
+108/−81 lines, 5 files
Files
- HsImport/Args.hs +16/−2
- HsImport/ImportSpec.hs +10/−2
- HsImport/Main.hs +31/−34
- hsimport.cabal +2/−1
- tests/Main.hs +49/−42
HsImport/Args.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, CPP #-} module HsImport.Args ( HsImportArgs(..)@@ -7,10 +7,15 @@ 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)@@ -20,6 +25,7 @@ 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" }@@ -29,5 +35,13 @@ &= helpArg [explicit, name "help", name "h"] &= versionArg [explicit, name "version", name "v", summary versionInfo] where- versionInfo = "hsimport version 0.2" summaryInfo = ""+++versionInfo :: String+versionInfo =+#ifdef CABAL+ "hsimport version " ++ showVersion version+#else+ "hsimport version unknown (not built with cabal)"+#endif
HsImport/ImportSpec.hs view
@@ -6,6 +6,7 @@ , parsedSrcFile , moduleToImport , symbolToImport+ , qualifiedName , saveToFile , hsImportSpec ) where@@ -21,6 +22,7 @@ , _parsedSrcFile :: HS.Module , _moduleToImport :: String , _symbolToImport :: Maybe String+ , _qualifiedName :: Maybe String , _saveToFile :: Maybe FilePath } deriving (Show) @@ -36,15 +38,21 @@ case result of HS.ParseOk modul -> return $ Right $ ImportSpec (Args.inputSrcFile args) modul- (Args.moduleName args) symbolName saveToFile+ (Args.moduleName args) symbolName+ qualifiedName saveToFile - HS.ParseFailed _ error -> return $ Left error+ HS.ParseFailed srcLoc error -> return $ Left (show srcLoc ++ 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
HsImport/Main.hs view
@@ -5,49 +5,46 @@ ) where import Control.Lens-import System.Directory (copyFile)+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 qualified Language.Haskell.Exts as HS import HsImport.ImportChange import HsImport.ImportSpec hsImport :: ImportSpec -> IO ()-hsImport spec =- case importChange (spec ^. moduleToImport) (spec ^. symbolToImport) (spec ^. parsedSrcFile) of- ReplaceImport importDecl ->- modifyLines $ \lines_ ->- let importLine = HS.prettyPrint importDecl- numDrops = HS.srcLine . HS.importLoc $ importDecl- numTakes = max 0 (numDrops - 1)- in take numTakes lines_ ++ [importLine] ++ drop numDrops lines_-- AddImport importDecl ->- modifyLines $ \lines_ ->- let importLine = HS.prettyPrint importDecl- numTakes = HS.srcLine . HS.importLoc $ importDecl- numDrops = numTakes- in take numTakes lines_ ++ [importLine] ++ drop numDrops lines_+hsImport spec = do+ let impChanges = importChanges (spec ^. moduleToImport)+ (spec ^. symbolToImport)+ (spec ^. qualifiedName)+ (spec ^. parsedSrcFile) - AddImportAtEnd importDecl ->- modifyLines $ \lines_ ->- let importLine = HS.prettyPrint importDecl- in lines_ ++ [importLine]+ 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') - NoImportChange- | Just saveTo <- spec ^. saveToFile -> copyFile (spec ^. sourceFile) saveTo- | otherwise -> return () where- modifyLines f = do- file <- TIO.readFile $ spec ^. sourceFile- let lines_ = lines . T.unpack $ file- lines_' = f lines_- file' = T.pack . unlines $ lines_'+ applyChanges = foldl' applyChange - TIO.writeFile (outputFile spec) file'+ applyChange srcLines (ReplaceImportAt srcLine importStr) =+ let numDrops = srcLine+ numTakes = max 0 (numDrops - 1)+ in take numTakes srcLines ++ [importStr] ++ drop numDrops srcLines - where- outputFile spec- | Just file <- spec ^. saveToFile = file- | otherwise = spec ^. sourceFile+ 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
hsimport.cabal view
@@ -1,5 +1,5 @@ Name: hsimport-Version: 0.2+Version: 0.2.1 License: BSD3 License-file: LICENSE Author: Daniel Trstenjak@@ -21,6 +21,7 @@ HsImport.ImportSpec HsImport.Main ghc-options: -W -funbox-strict-fields+ cpp-options: -DCABAL Build-Depends: base >= 3 && < 5, cmdargs >= 0.10.5 && < 0.11, haskell-src-exts >= 1.14.0 && < 1.15,
tests/Main.hs view
@@ -14,64 +14,71 @@ moduleTests :: TestTree moduleTests = testGroup "Module Tests"- [ hsImportTest "ModuleTest0" "Foo.Bar" "" - , hsImportTest "ModuleTest1" "Foo.Bar" ""- , hsImportTest "ModuleTest2" "Foo.Bar.Blub" ""- , hsImportTest "ModuleTest3" "Control.Monad" ""- , hsImportTest "ModuleTest4" "Ugah.Argh2" ""- , hsImportTest "ModuleTest5" "Control.Monad" ""- , hsImportTest "ModuleTest6" "Control.Monad" ""- , hsImportTest "ModuleTest7" "Control.Monad" ""- , hsImportTest "ModuleTest8" "Control.Monad" ""- , hsImportTest "ModuleTest9" "Control.Monad" ""- , hsImportTest "ModuleTest10" "Control.Monad" ""- , hsImportTest "ModuleTest11" "Control.Monad" ""- , hsImportTest "ModuleTest12" "Control.Monad" ""- , hsImportTest "ModuleTest13" "Control.Monad" ""- , hsImportTest "ModuleTest14" "Control.Monad" ""- , hsImportTest "ModuleTest15" "Control.Monad" ""- , hsImportTest "ModuleTest16" "Control.Monad" ""- , hsImportTest "ModuleTest17" "Control.Monad" ""- , hsImportTest "ModuleTest18" "Control.Monad" ""- , hsImportTest "ModuleTest19" "Control.Monad" ""- , hsImportTest "ModuleTest20" "Control.Monad" ""- , hsImportTest "ModuleTest21" "Control.Monad" ""+ [ hsImportTest "ModuleTest0" "Foo.Bar" "" ""+ , hsImportTest "ModuleTest1" "Foo.Bar" "" ""+ , hsImportTest "ModuleTest2" "Foo.Bar.Blub" "" ""+ , hsImportTest "ModuleTest3" "Control.Monad" "" ""+ , hsImportTest "ModuleTest4" "Ugah.Argh2" "" ""+ , hsImportTest "ModuleTest5" "Control.Monad" "" ""+ , hsImportTest "ModuleTest6" "Control.Monad" "" ""+ , hsImportTest "ModuleTest7" "Control.Monad" "" ""+ , hsImportTest "ModuleTest8" "Control.Monad" "" ""+ , hsImportTest "ModuleTest9" "Control.Monad" "" ""+ , hsImportTest "ModuleTest10" "Control.Monad" "" ""+ , hsImportTest "ModuleTest11" "Control.Monad" "" ""+ , hsImportTest "ModuleTest12" "Control.Monad" "" ""+ , hsImportTest "ModuleTest13" "Control.Monad" "" ""+ , hsImportTest "ModuleTest14" "Control.Monad" "" ""+ , hsImportTest "ModuleTest15" "Control.Monad" "" ""+ , hsImportTest "ModuleTest16" "Control.Monad" "" ""+ , hsImportTest "ModuleTest17" "Control.Monad" "" ""+ , hsImportTest "ModuleTest18" "Control.Monad" "" ""+ , hsImportTest "ModuleTest19" "Control.Monad" "" ""+ , hsImportTest "ModuleTest20" "Control.Monad" "" ""+ , hsImportTest "ModuleTest21" "Control.Monad" "" ""+ , hsImportTest "ModuleTest22" "Control.Monad" "" ""+ , hsImportTest "ModuleTest23" "Control.Monad" "" "CM"+ , hsImportTest "ModuleTest24" "Control.Monad" "" "CM" ] symbolTests :: TestTree symbolTests = testGroup "Symbol Tests"- [ hsImportTest "SymbolTest0" "Foo.Bar" "foo"- , hsImportTest "SymbolTest1" "Foo.Bar" "foo"- , hsImportTest "SymbolTest2" "Foo.Bar.Blub" "foo"- , hsImportTest "SymbolTest3" "Control.Monad" "when"- , hsImportTest "SymbolTest4" "Ugah.Argh2" "argh"- , hsImportTest "SymbolTest5" "Control.Monad" "when"- , hsImportTest "SymbolTest6" "Control.Monad" "unless"- , hsImportTest "SymbolTest7" "Control.Monad" "unless"- , hsImportTest "SymbolTest8" "Control.Monad" "unless"- , hsImportTest "SymbolTest9" "Control.Monad" "unless"- , hsImportTest "SymbolTest10" "Control.Applicative" "<$>"- , hsImportTest "SymbolTest11" "Control.Applicative" "<$>"- , hsImportTest "SymbolTest12" "Control.Applicative" "<$>"- , hsImportTest "SymbolTest13" "Control.Applicative" "<*"- , hsImportTest "SymbolTest14" "Control.Applicative" "<*"- , hsImportTest "SymbolTest15" "Control.Applicative" "*>"+ [ hsImportTest "SymbolTest0" "Foo.Bar" "foo" ""+ , hsImportTest "SymbolTest1" "Foo.Bar" "foo" ""+ , hsImportTest "SymbolTest2" "Foo.Bar.Blub" "foo" ""+ , hsImportTest "SymbolTest3" "Control.Monad" "when" ""+ , hsImportTest "SymbolTest4" "Ugah.Argh2" "argh" ""+ , hsImportTest "SymbolTest5" "Control.Monad" "when" ""+ , hsImportTest "SymbolTest6" "Control.Monad" "unless" ""+ , hsImportTest "SymbolTest7" "Control.Monad" "unless" ""+ , hsImportTest "SymbolTest8" "Control.Monad" "unless" ""+ , hsImportTest "SymbolTest9" "Control.Monad" "unless" ""+ , hsImportTest "SymbolTest10" "Control.Applicative" "<$>" ""+ , hsImportTest "SymbolTest11" "Control.Applicative" "<$>" ""+ , hsImportTest "SymbolTest12" "Control.Applicative" "<$>" ""+ , hsImportTest "SymbolTest13" "Control.Applicative" "<*" ""+ , hsImportTest "SymbolTest14" "Control.Applicative" "<*" ""+ , hsImportTest "SymbolTest15" "Control.Applicative" "*>" ""+ , hsImportTest "SymbolTest16" "Control.Monad" "when" "CM" ] -hsImportTest :: String -> String -> String -> TestTree-hsImportTest testName moduleName symbolName =- goldenVsFile testName goldenFile outputFile command+hsImportTest :: String -> String -> String -> String -> TestTree+hsImportTest testName moduleName symbolName qualifiedName =+ goldenVsFileDiff testName diff goldenFile outputFile command where command = do handle <- runCommand $ "hsimport " ++ params waitForProcess handle return () - params = intercalate " " [moduleParam, symbolParam, outputParam, inputFile]+ diff ref new = ["diff", "-u", ref, new]++ params = intercalate " " [moduleParam, symbolParam, qualParam, outputParam, inputFile] moduleParam = "-m '" ++ moduleName ++ "'" symbolParam = if null symbolName then "" else "-s '" ++ symbolName ++ "'"+ qualParam = if null qualifiedName then "" else "-q '" ++ qualifiedName ++ "'" outputParam = "-o '" ++ outputFile ++ "'" goldenFile = "tests" </> "goldenFiles" </> testName <.> "hs"