diff --git a/HsImport.hs b/HsImport.hs deleted file mode 100644 --- a/HsImport.hs +++ /dev/null @@ -1,11 +0,0 @@ - -module HsImport - ( HsImportArgs - , hsImportArgs - , module HsImport.ImportSpec - , module HsImport.Main - ) where - -import HsImport.Args -import HsImport.ImportSpec -import HsImport.Main diff --git a/HsImport/Args.hs b/HsImport/Args.hs deleted file mode 100644 --- a/HsImport/Args.hs +++ /dev/null @@ -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 diff --git a/HsImport/ImportSpec.hs b/HsImport/ImportSpec.hs deleted file mode 100644 --- a/HsImport/ImportSpec.hs +++ /dev/null @@ -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 diff --git a/HsImport/Main.hs b/HsImport/Main.hs deleted file mode 100644 --- a/HsImport/Main.hs +++ /dev/null @@ -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 diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -1,13 +0,0 @@ - -module Main where - -import System.Exit (exitFailure, exitSuccess) -import HsImport - -main :: IO () -main = do - args <- hsImportArgs - maybeSpec <- hsImportSpec args - case maybeSpec of - Left error -> putStrLn ("hsimport: " ++ error) >> exitFailure - Right spec -> hsImport spec >> exitSuccess diff --git a/hsimport.cabal b/hsimport.cabal --- a/hsimport.cabal +++ b/hsimport.cabal @@ -1,5 +1,5 @@ Name: hsimport -Version: 0.2.5 +Version: 0.2.6 License: BSD3 License-file: LICENSE Author: Daniel Trstenjak @@ -15,12 +15,13 @@ location: https://github.com/dan-t/hsimport Executable hsimport + hs-source-dirs: src Main-is: Main.hs other-modules: HsImport HsImport.Args HsImport.ImportSpec HsImport.Main - ghc-options: -W -funbox-strict-fields + ghc-options: -W cpp-options: -DCABAL Build-Depends: base >= 3 && < 5, cmdargs >= 0.10.5 && < 0.11, @@ -33,7 +34,9 @@ directory >= 1.2.0.1 && < 1.3 library - ghc-options: -W -funbox-strict-fields + hs-source-dirs: src + ghc-options: -W + cpp-options: -DCABAL exposed-modules: HsImport HsImport.Args HsImport.ImportSpec @@ -50,7 +53,7 @@ Executable hsimport-tests Main-is: tests/Main.hs - ghc-options: -W -funbox-strict-fields + ghc-options: -W Build-Depends: base >= 3 && < 5, tasty >= 0.6 && < 0.7, tasty-golden >= 2.2.0.1 && < 2.3, diff --git a/src/HsImport.hs b/src/HsImport.hs new file mode 100644 --- /dev/null +++ b/src/HsImport.hs @@ -0,0 +1,11 @@ + +module HsImport + ( HsImportArgs + , hsImportArgs + , module HsImport.ImportSpec + , module HsImport.Main + ) where + +import HsImport.Args +import HsImport.ImportSpec +import HsImport.Main diff --git a/src/HsImport/Args.hs b/src/HsImport/Args.hs new file mode 100644 --- /dev/null +++ b/src/HsImport/Args.hs @@ -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 diff --git a/src/HsImport/ImportSpec.hs b/src/HsImport/ImportSpec.hs new file mode 100644 --- /dev/null +++ b/src/HsImport/ImportSpec.hs @@ -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 diff --git a/src/HsImport/Main.hs b/src/HsImport/Main.hs new file mode 100644 --- /dev/null +++ b/src/HsImport/Main.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,13 @@ + +module Main where + +import System.Exit (exitFailure, exitSuccess) +import HsImport + +main :: IO () +main = do + args <- hsImportArgs + maybeSpec <- hsImportSpec args + case maybeSpec of + Left error -> putStrLn ("hsimport: " ++ error) >> exitFailure + Right spec -> hsImport spec >> exitSuccess diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -40,6 +40,7 @@ , hsImportTest "ModuleTest23" "Control.Monad" "" "CM" , hsImportTest "ModuleTest24" "Control.Monad" "" "CM" , hsImportTest "ModuleTest25" "Control.Monad" "" "Control.Monad" + , hsImportTest "ModuleTest26" "Control.Monad" "" "" ]