shift 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+52/−58 lines, 3 filesdep +binarydep −aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: binary

Dependencies removed: aeson

API changes (from Hackage documentation)

Files

• shift.cabal +3/−3
• src/Teleport.hs +48/−54
• stack.yaml +1/−1

@@ -1,7 +1,7 @@ name:                shift-version:             0.1.0.0+version:             0.2.0.0 synopsis:            A tool to quickly switch between directories-description:         Please see README.md for details+description:         This is a command-line tool to "teleport" between directories homepage:            https://github.com/vmchale/teleport#readme license:             MIT license-file:        LICENSE@@ -26,7 +26,7 @@                      , optparse-applicative                      , system-filepath                      , text-                     , aeson+                     , binary                      , composition                      , lens                      , bytestring

@@ -1,30 +1,32 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TemplateHaskell   #-}  module Teleport where -import Control.Monad-import Data.Maybe-import Data.List-import Prelude hiding (FilePath)-import qualified Data.Text as T-import Data.Text.Encoding-import Options.Applicative-import Data.Monoid-import Filesystem.Path.CurrentOS as P-import Turtle hiding (header, find)-import Data.Aeson as A-import qualified Data.ByteString.Lazy as BSL-import System.Console.ANSI-import Filesystem as P-import System.Environment -import Paths_shift-import Data.Version-import Data.Default-import Control.Lens hiding (argument)-import Data.Composition-import GHC.Generics+import           Control.Lens              hiding (argument)+import           Control.Monad+import           Data.Binary+import qualified Data.ByteString.Lazy      as BSL+import           Data.Composition+import           Data.Default+import           Data.List+import           Data.Maybe+import           Data.Monoid+import qualified Data.Text                 as T+import           Data.Text.Encoding+import           Data.Version+import           Filesystem                as P+import qualified Filesystem.Path.CurrentOS as P+import           GHC.Generics+import           Options.Applicative+import           Paths_shift+import           Prelude                   hiding (FilePath)+import           System.Console.ANSI+import           System.Environment+import           Turtle                    hiding (find, header)  -- | options for 'warp add' data AddOptions = AddOptions { folderPath :: Maybe String,@@ -36,26 +38,21 @@ -- | options for 'warp goto' newtype GotoOptions = GotoOptions { gotoname :: String } --- | data type for command +-- | data type for command data Command = Display | Add AddOptions | Remove RemoveOptions | Goto GotoOptions  -- an abstract entity representing a point to which we can warp to data WarpPoint = WarpPoint { _name          :: String,-                             _absFolderPath :: String } deriving (Default, Generic)+                             _absFolderPath :: String } deriving (Default, Generic, Binary) --- the main data that is loaded from JSON -newtype WarpData = WarpData { _warpPoints :: [WarpPoint] } deriving (Default, Generic)+-- the main data that is loaded from JSON+newtype WarpData = WarpData { _warpPoints :: [WarpPoint] } deriving (Default, Generic, Binary)  makeLenses ''WarpData makeLenses ''WarpPoint -instance FromJSON WarpPoint where-instance ToJSON WarpPoint where-instance FromJSON WarpData where-instance ToJSON WarpData where- exec :: IO ()-exec = execParser opts >>= run +exec = execParser opts >>= run     where versionInfo = infoOption ("teleport version: " ++ showVersion version) (short 'v' <> long "version" <> help "Show version")           opts        = info (helper <*> versionInfo <*> parseCommand)                             (fullDesc@@ -63,16 +60,13 @@                             <> header "Warp: move around your filesystem")  dieJSONParseError :: FilePath -> String -> IO WarpData-dieJSONParseError path err = die . T.pack . foldr (<>) mempty $ -    ["parse error in: " -    , show path +dieJSONParseError path err = die . T.pack . foldr (<>) mempty $+    ["parse error in: "+    , show path     , "\nerror:      \n" <> err ]  decodeWarpData :: FilePath -> IO WarpData-decodeWarpData path = (fmap eitherDecode' . BSL.readFile . encodeString) path >>= \x ->-    case x of-        Left err -> dieJSONParseError path err-        Right json -> pure json+decodeWarpData = fmap decode . BSL.readFile . P.encodeString  loadWarpData :: FilePath -> IO WarpData loadWarpData jsonFilePath = testfile jsonFilePath >>= \exists ->@@ -81,16 +75,16 @@  saveWarpData :: FilePath -> WarpData -> IO () saveWarpData jsonFilePath warpData = touch jsonFilePath >>-    let dataBytestring = A.encode warpData in-        BSL.writeFile (encodeString jsonFilePath) dataBytestring+    let dataBytestring = encode warpData in+        BSL.writeFile (P.encodeString jsonFilePath) dataBytestring  warpDataPath :: IO FilePath-warpDataPath = home >>= \homeFolder -> +warpDataPath = home >>= \homeFolder ->     pure (homeFolder </> ".warpdata")  readFolderPath :: String -> ReadM FilePath readFolderPath = f . fromText . T.pack-    where f path = if valid path then pure path else readerError ("invalid path: " <> show path)+    where f path = if P.valid path then pure path else readerError ("invalid path: " <> show path)  warpnameParser :: Parser String warpnameParser = argument str@@ -114,14 +108,14 @@ parseGotoCommand = Goto . GotoOptions <$> warpnameParser  parseCommand :: Parser Command-parseCommand = hsubparser +parseCommand = hsubparser     (command "add" (info parseAddCommand (progDesc "add a warp point"))     <> (command "list" (info (pure Display) (progDesc "list all warp points")))     <> (command "del" (info parseRemoveCommand (progDesc "delete a warp point")))     <> (command "to" (info parseGotoCommand (progDesc "go to a created warp point"))))  setErrorColor :: IO ()-setErrorColor = setSGR [SetColor Foreground Vivid Red]    +setErrorColor = setSGR [SetColor Foreground Vivid Red]  colorWhen :: IO () -> IO () colorWhen act = do@@ -136,7 +130,7 @@     putStr $ "\t" <> _absFolderPath warpPoint <> "\n"  folderNotFoundError :: FilePath -> IO ()-folderNotFoundError path = setErrorColor >> +folderNotFoundError path = setErrorColor >>     (die . T.pack $ ("unable to find folder: " ++ show path))  needFolderNotFileError :: FilePath -> IO ()@@ -149,7 +143,7 @@     , flip unless (folderNotFoundError path) =<< testdir path ]  dieWarpPointExists :: WarpPoint -> IO ()-dieWarpPointExists warpPoint  = foldr (>>) (pure def) +dieWarpPointExists warpPoint  = foldr (>>) (pure def)     [ setErrorColor     , putStrLn $ "warp point " <> _name warpPoint <> " already exists:\n"     , warpPointPrint warpPoint ]@@ -165,16 +159,16 @@         Just warpPoint -> dieWarpPointExists warpPoint         Nothing -> do                         putStrLn "creating warp point: \n"-                        let newWarpPoint = def & name .~ addname & absFolderPath .~ encodeString _absFolderPath+                        let newWarpPoint = def & name .~ addname & absFolderPath .~ P.encodeString _absFolderPath                         warpPointPrint newWarpPoint                         let newWarpData = over warpPoints (newWarpPoint:) warpData                         flip saveWarpData newWarpData =<< warpDataPath-    + runDisplay :: IO () runDisplay = do     warpData <- loadWarpData =<< warpDataPath     forM_ (_warpPoints warpData) warpPointPrint-    + dieWarpPointNotFound :: String ->IO () dieWarpPointNotFound w = setErrorColor >> (die . T.pack)     (w <> " warp point not found")@@ -186,7 +180,7 @@     let wantedWarpPoint = find ((/= removename) . _name) (_warpPoints warp)     case wantedWarpPoint of         Nothing -> dieWarpPointNotFound removename-        Just _ -> saveWarpData warpPath +        Just _ -> saveWarpData warpPath             (over warpPoints (filter ((/= removename) . _name)) warp)  runGoto :: GotoOptions -> IO ()@@ -201,9 +195,9 @@                              cd . fromString $ _absFolderPath warpPoint                              setWorkingDirectory . fromString . _absFolderPath $ warpPoint                              exit (ExitFailure 2)-      + run :: Command -> IO ()-run (Add addOpt) = runAdd addOpt-run Display = runDisplay+run (Add addOpt)       = runAdd addOpt+run Display            = runDisplay run (Remove removeOpt) = runRemove removeOpt-run (Goto gotoOpt) = runGoto gotoOpt+run (Goto gotoOpt)     = runGoto gotoOpt

@@ -1,4 +1,4 @@-resolver: lts-8.13+resolver: lts-8.23 packages: - '.' extra-deps: []