shift 0.2.1.2 → 0.2.1.3
raw patch · 2 files changed
+47/−29 lines, 2 files
Files
- shift.cabal +21/−20
- src/Teleport.hs +26/−9
shift.cabal view
@@ -1,34 +1,35 @@-cabal-version: >=1.10-name: shift-version: 0.2.1.2-license: MIT-license-file: LICENSE-copyright: 2010 Siddharth Bhat, 2017-2019 Vanessa McHale-maintainer: vamchale@gmail.com-author: Siddharth Bhat, Vanessa McHale-bug-reports: https://github.com/vmchale/teleport/issues-synopsis: A tool to quickly switch between directories+cabal-version: >=1.10+name: shift+version: 0.2.1.3+license: MIT+license-file: LICENSE+copyright: 2010 Siddharth Bhat, 2017-2019 Vanessa McHale+maintainer: vamchale@gmail.com+author: Siddharth Bhat, Vanessa McHale+bug-reports: https://github.com/vmchale/teleport/issues+synopsis: A tool to quickly switch between directories description: This is a command-line tool to "teleport" between directories-category: Tools-build-type: Simple++category: Tools+build-type: Simple extra-source-files: README.md bash/teleport source-repository head- type: git+ type: git location: https://github.com/vmchale/teleport executable teleport-hask- main-is: Teleport.hs- hs-source-dirs: src- other-modules:- Paths_shift+ main-is: Teleport.hs+ hs-source-dirs: src+ other-modules: Paths_shift default-language: Haskell2010- other-extensions: DeriveAnyClass DeriveGeneric OverloadedStrings- RecordWildCards- ghc-options: -fwarn-unused-imports -Wall+ other-extensions:+ DeriveAnyClass DeriveGeneric OverloadedStrings RecordWildCards++ ghc-options: -fwarn-unused-imports -Wall build-depends: base >=4.9 && <5, optparse-applicative -any,
src/Teleport.hs view
@@ -18,10 +18,10 @@ import GHC.Generics (Generic) import Options.Applicative import Paths_shift-import Prelude import System.Console.ANSI import System.Directory (canonicalizePath, doesDirectoryExist,- doesFileExist, setCurrentDirectory)+ doesFileExist, getCurrentDirectory,+ setCurrentDirectory) import System.Environment import System.Exit (ExitCode (..), die, exitWith) import System.FilePath ((</>))@@ -39,12 +39,16 @@ | Remove RemoveOptions | Goto GotoOptions | Replace String+ | Here -- an abstract entity representing a point to which we can warp to data WarpPoint = WarpPoint { _name :: String , _absFolderPath :: String } deriving (Generic, Binary) +keyByDir :: WarpPoint -> (String, String)+keyByDir (WarpPoint x y) = (y, x)+ -- the main data that is loaded from config newtype WarpData = WarpData { _warpPoints :: [WarpPoint] } deriving (Generic, Binary)@@ -74,7 +78,7 @@ saveWarpData :: FilePath -> WarpData -> IO () saveWarpData configFilePath warpData = let dataBytestring = encode warpData in- BSL.writeFile (configFilePath) dataBytestring+ BSL.writeFile configFilePath dataBytestring warpDataPath :: IO FilePath warpDataPath = do@@ -111,7 +115,8 @@ <> command "list" (info (pure Display) (progDesc "list all warp points")) <> command "del" (info parseRemoveCommand (progDesc "delete a warp point")) <> command "replace" (info parseReplaceCommand (progDesc "replace a warp point"))- <> command "to" (info parseGotoCommand (progDesc "go to a created warp point")))+ <> command "to" (info parseGotoCommand (progDesc "go to a created warp point"))+ <> command "here" (info (pure Here) (progDesc "list relevant warp point for current dir"))) setErrorColor :: IO () setErrorColor = setSGR [SetColor Foreground Vivid Red]@@ -130,11 +135,11 @@ folderNotFoundError :: FilePath -> IO () folderNotFoundError path = setErrorColor *>- (die $ ("unable to find folder: " ++ show path))+ die ("unable to find folder: " ++ show path) needFolderNotFileError :: FilePath -> IO () needFolderNotFileError path = setErrorColor *>- (die $ "expected folder, not file: " ++ show path)+ die ("expected folder, not file: " ++ show path) dieIfFolderNotFound :: FilePath -> IO () dieIfFolderNotFound path = sequence_@@ -169,6 +174,17 @@ warpData <- loadWarpData =<< warpDataPath forM_ (_warpPoints warpData) warpPointPrint +runHere :: IO ()+runHere = do+ warpData <- loadWarpData =<< warpDataPath+ pwd <- getCurrentDirectory+ case lookup pwd (keyByDir <$> _warpPoints warpData) of+ Just y -> do+ { colorWhen $ setSGR [SetColor Foreground Dull White]+ ; putStrLn y+ }+ Nothing -> dieWarpPointNotFound pwd+ dieWarpPointNotFound :: String -> IO () dieWarpPointNotFound wStr = setErrorColor *> die (wStr <> " warp point not found")@@ -191,13 +207,14 @@ case wantedWarpPoint of Nothing -> dieWarpPointNotFound gotoname Just warpPoint -> do- putStrLn $ _absFolderPath $ warpPoint- setCurrentDirectory $ _absFolderPath $ warpPoint+ putStrLn $ _absFolderPath warpPoint+ setCurrentDirectory $ _absFolderPath warpPoint exitWith (ExitFailure 2) run :: Command -> IO () run (Add addOpt) = runAdd addOpt run Display = runDisplay run (Remove removeOpt) = runRemove removeOpt-run (Replace strR) = runRemove (RemoveOptions strR) *> runAdd (AddOptions Nothing strR)+run (Replace strR) = runRemove (RemoveOptions strR) *> runAdd (AddOptions Nothing strR) run (Goto gotoOpt) = runGoto gotoOpt+run Here = runHere