shift 0.2.1.1 → 0.2.1.2
raw patch · 2 files changed
+41/−49 lines, 2 filesdep +directorydep +filepathdep −microlensdep −system-fileiodep −system-filepathdep ~base
Dependencies added: directory, filepath
Dependencies removed: microlens, system-fileio, system-filepath, text, turtle
Dependency ranges changed: base
Files
- shift.cabal +5/−9
- src/Teleport.hs +36/−40
shift.cabal view
@@ -1,12 +1,11 @@ cabal-version: >=1.10 name: shift-version: 0.2.1.1+version: 0.2.1.2 license: MIT license-file: LICENSE-copyright: 2010 Siddharth Bhat, 2017-2018 Vanessa McHale+copyright: 2010 Siddharth Bhat, 2017-2019 Vanessa McHale maintainer: vamchale@gmail.com author: Siddharth Bhat, Vanessa McHale-stability: unstable bug-reports: https://github.com/vmchale/teleport/issues synopsis: A tool to quickly switch between directories description:@@ -31,14 +30,11 @@ RecordWildCards ghc-options: -fwarn-unused-imports -Wall build-depends:- base >=4.7 && <5,- turtle -any,+ base >=4.9 && <5, optparse-applicative -any,- system-filepath -any,- text -any, binary -any, composition-prelude -any,- microlens -any, bytestring -any, ansi-terminal -any,- system-fileio -any+ directory -any,+ filepath -any
src/Teleport.hs view
@@ -5,30 +5,26 @@ module Main (main) where -import Control.Composition hiding ((&))+import Control.Composition hiding ((&)) import Control.Monad import Data.Binary-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL-import Data.Functor (($>))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Functor (($>)) import Data.List-import Data.Maybe-import qualified Data.Text as T-import Data.Text.Encoding+import Data.Maybe (fromMaybe)+import Data.Semigroup ((<>)) import Data.Version-import Filesystem as P-import qualified Filesystem.Path.CurrentOS as P-import GHC.Generics-import Lens.Micro+import GHC.Generics (Generic) import Options.Applicative import Paths_shift-import Prelude hiding (FilePath)+import Prelude import System.Console.ANSI+import System.Directory (canonicalizePath, doesDirectoryExist,+ doesFileExist, setCurrentDirectory) import System.Environment-import Turtle (ExitCode (ExitFailure), FilePath,- cd, die, echo, exit, fromString,- home, realpath, testdir, testfile,- unsafeTextToLine, (</>), (<>))+import System.Exit (ExitCode (..), die, exitWith)+import System.FilePath ((</>)) data AddOptions = AddOptions { folderPath :: Maybe String, addname :: String }@@ -56,8 +52,8 @@ defaultWarpData :: WarpData defaultWarpData = WarpData [] -warpPoints :: Lens' WarpData [WarpPoint]-warpPoints f s = fmap (\x -> s { _warpPoints = x }) (f (_warpPoints s))+mapWarpPoints :: ([WarpPoint] -> [WarpPoint]) -> WarpData -> WarpData+mapWarpPoints f (WarpData ws) = WarpData (f ws) main :: IO () main = execParser opts >>= run@@ -68,21 +64,22 @@ <> header "Warp: move around your filesystem") decodeWarpData :: FilePath -> IO WarpData-decodeWarpData = fmap decode . (fmap BSL.fromStrict . BS.readFile) . P.encodeString+decodeWarpData = fmap decode . (fmap BSL.fromStrict . BS.readFile) loadWarpData :: FilePath -> IO WarpData-loadWarpData configFilePath = testfile configFilePath >>= \exists ->+loadWarpData configFilePath = doesFileExist configFilePath >>= \exists -> if exists then decodeWarpData configFilePath else saveWarpData configFilePath defaultWarpData $> defaultWarpData saveWarpData :: FilePath -> WarpData -> IO () saveWarpData configFilePath warpData = let dataBytestring = encode warpData in- BSL.writeFile (P.encodeString configFilePath) dataBytestring+ BSL.writeFile (configFilePath) dataBytestring warpDataPath :: IO FilePath-warpDataPath = home >>= \homeFolder ->- pure (homeFolder </> ".warpdata")+warpDataPath = do+ home <- getEnv "HOME"+ pure (home </> ".warpdata") warpnameParser :: Parser String warpnameParser = argument str@@ -132,17 +129,17 @@ putStr $ "\t" <> _absFolderPath warpPoint <> "\n" folderNotFoundError :: FilePath -> IO ()-folderNotFoundError path = setErrorColor >>- (die . T.pack $ ("unable to find folder: " ++ show path))+folderNotFoundError path = setErrorColor *>+ (die $ ("unable to find folder: " ++ show path)) needFolderNotFileError :: FilePath -> IO ()-needFolderNotFileError path = setErrorColor >>- (die . T.pack $ "expected folder, not file: " ++ show path)+needFolderNotFileError path = setErrorColor *>+ (die $ "expected folder, not file: " ++ show path) dieIfFolderNotFound :: FilePath -> IO () dieIfFolderNotFound path = sequence_- [ flip when (needFolderNotFileError path) =<< testfile path- , flip unless (folderNotFoundError path) =<< testdir path ]+ [ flip when (needFolderNotFileError path) =<< doesFileExist path+ , flip unless (folderNotFoundError path) =<< doesDirectoryExist path ] dieWarpPointExists :: WarpPoint -> IO () dieWarpPointExists warpPoint = sequence_@@ -153,18 +150,18 @@ runAdd :: AddOptions -> IO () runAdd AddOptions{..} = do- dieIfFolderNotFound . P.decode . encodeUtf8 . T.pack . fromMaybe "./" $ folderPath+ dieIfFolderNotFound . fromMaybe "./" $ folderPath putStrLn "folder exists, loading warp data..." warpData <- loadWarpData =<< warpDataPath- _absFolderPath <- realpath . P.decode . encodeUtf8 . T.pack . fromMaybe "./" $ folderPath+ _absFolderPath <- canonicalizePath . fromMaybe "./" $ folderPath let existingWarpPoint = find ((==addname) . _name) (_warpPoints warpData) case existingWarpPoint of Just warpPoint -> dieWarpPointExists warpPoint Nothing -> do putStrLn "creating warp point: \n"- let newWarpPoint = WarpPoint addname (P.encodeString _absFolderPath)+ let newWarpPoint = WarpPoint addname _absFolderPath warpPointPrint newWarpPoint- let newWarpData = over warpPoints (newWarpPoint:) warpData+ let newWarpData = mapWarpPoints (newWarpPoint:) warpData flip saveWarpData newWarpData =<< warpDataPath runDisplay :: IO ()@@ -172,8 +169,8 @@ warpData <- loadWarpData =<< warpDataPath forM_ (_warpPoints warpData) warpPointPrint -dieWarpPointNotFound :: String ->IO ()-dieWarpPointNotFound wStr = setErrorColor >> (die . T.pack)+dieWarpPointNotFound :: String -> IO ()+dieWarpPointNotFound wStr = setErrorColor *> die (wStr <> " warp point not found") runRemove :: RemoveOptions -> IO ()@@ -184,7 +181,7 @@ case wantedWarpPoint of Nothing -> dieWarpPointNotFound removename Just _ -> saveWarpData warpPath- (over warpPoints (filter ((/= removename) . _name)) warp)+ (mapWarpPoints (filter ((/= removename) . _name)) warp) runGoto :: GotoOptions -> IO () runGoto GotoOptions{..} = do@@ -194,10 +191,9 @@ case wantedWarpPoint of Nothing -> dieWarpPointNotFound gotoname Just warpPoint -> do- echo (unsafeTextToLine . T.pack . _absFolderPath $ warpPoint)- cd . fromString $ _absFolderPath warpPoint- setWorkingDirectory . fromString . _absFolderPath $ warpPoint- exit (ExitFailure 2)+ putStrLn $ _absFolderPath $ warpPoint+ setCurrentDirectory $ _absFolderPath $ warpPoint+ exitWith (ExitFailure 2) run :: Command -> IO () run (Add addOpt) = runAdd addOpt