shift (empty) → 0.1.0.0

raw patch · 8 files changed

+363/−0 lines, 8 filesdep +aesondep +ansi-terminaldep +basesetup-changed

Dependencies added: aeson, ansi-terminal, base, bytestring, composition, data-default, lens, optparse-applicative, shift, system-fileio, system-filepath, text, turtle

Files

• LICENSE +30/−0
• README.md +50/−0
• Setup.hs +2/−0
• app/Main.hs +6/−0
• bash/teleport +9/−0
• shift.cabal +51/−0
• src/Teleport.hs +209/−0
• stack.yaml +6/−0

@@ -0,0 +1,30 @@+Copyright Siddharth Bhat (c) 2015, Vanessa McHale (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,50 @@+# Teleport++A fork of [teleport](https://github.com/bollu/teleport) with a focus on clean,+functional code.++## Use++Unfortunately, since we can't change the directory of the user (possibly an+upstream bug), we have to wrap `teleport-hask` in a bash script, so put+`bash/teleport` on your `PATH` somewhere.++I also put the following in my `~/.bashrc` so that `teleport` would run in the+correct shell:++```bash+alias go="source $HOME/.local/bin/teleport"+```++## Code++[tokei](https://github.com/Aaronepower/tokei) output for previous package:++```+-------------------------------------------------------------------------------+ Language            Files        Lines         Code     Comments       Blanks+-------------------------------------------------------------------------------+ Cabal                   1           60           53            1            6+ Haskell                 4          383          248           51           84+ Markdown                2           22           22            0            0+ Shell                   1           11            7            3            1+ YAML                    1           29            5           16            8+-------------------------------------------------------------------------------+ Total                   9          505          335           71           99+-------------------------------------------------------------------------------+```++For the forked package:++```+-------------------------------------------------------------------------------+ Language            Files        Lines         Code     Comments       Blanks+-------------------------------------------------------------------------------+ Cabal                   1           51           48            0            3+ Haskell                 3          213          167            9           37+ Markdown                1           23           23            0            0+ YAML                    1            6            6            0            0+-------------------------------------------------------------------------------+ Total                   6          293          244            9           40+-------------------------------------------------------------------------------+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,6 @@+module Main where++import Teleport++main :: IO ()+main = exec

@@ -0,0 +1,9 @@+#!/bin/bash+OUTPUT=`teleport-hask $@`+# return code 2 is used to indicate that the shell script+# should use the output to warp to+if [[ $? -eq 2 ]]; then+    cd "$OUTPUT"+else+    echo "$OUTPUT"+fi

@@ -0,0 +1,51 @@+name:                shift+version:             0.1.0.0+synopsis:            A tool to quickly switch between directories+description:         Please see README.md for details+homepage:            https://github.com/vmchale/teleport#readme+license:             MIT+license-file:        LICENSE+author:              Siddharth Bhat, Vanessa McHale+maintainer:          vamchale@gmail.com+copyright:           2010 Siddharth Bhat, 2017 Vanessa McHale+category:            Tools+build-type:          Simple+bug-reports:         https://github.com/vmchale/teleport/issues +stability:           unstable+cabal-version:       >=1.10+extra-source-files:  README.md+                   , stack.yaml+                   , bash/teleport++library+  hs-source-dirs:      src+  exposed-modules:     Teleport+  other-modules:       Paths_shift+  build-depends:       base >= 4.7 && < 5+                     , turtle+                     , optparse-applicative+                     , system-filepath+                     , text+                     , aeson+                     , composition+                     , lens+                     , bytestring+                     , ansi-terminal+                     , system-fileio+                     , data-default+  default-language:    Haskell2010+  default-extensions:  DeriveAnyClass+                     , DeriveGeneric+  ghc-options:         -fwarn-unused-imports++executable teleport-hask+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , shift+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/vmchale/teleport

@@ -0,0 +1,209 @@+{-# 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++-- | options for 'warp add'+data AddOptions = AddOptions { folderPath :: Maybe String,+                               addname    :: String }++-- | options for 'warp remove'+newtype RemoveOptions = RemoveOptions { removename :: String }++-- | options for 'warp goto'+newtype GotoOptions = GotoOptions { gotoname :: String }++-- | 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)++-- the main data that is loaded from JSON +newtype WarpData = WarpData { _warpPoints :: [WarpPoint] } deriving (Default, Generic)++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 +    where versionInfo = infoOption ("teleport version: " ++ showVersion version) (short 'v' <> long "version" <> help "Show version")+          opts        = info (helper <*> versionInfo <*> parseCommand)+                            (fullDesc+                            <>progDesc "use warp to quickly setup warp points and move between them"+                            <> header "Warp: move around your filesystem")++dieJSONParseError :: FilePath -> String -> IO WarpData+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++loadWarpData :: FilePath -> IO WarpData+loadWarpData jsonFilePath = testfile jsonFilePath >>= \exists ->+    if exists then decodeWarpData jsonFilePath+    else saveWarpData jsonFilePath def >> pure def++saveWarpData :: FilePath -> WarpData -> IO ()+saveWarpData jsonFilePath warpData = touch jsonFilePath >>+    let dataBytestring = A.encode warpData in+        BSL.writeFile (encodeString jsonFilePath) dataBytestring++warpDataPath :: IO FilePath+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)++warpnameParser :: Parser String+warpnameParser = argument str+    (metavar "NAME"+    <> help "name of the warp point")++parseAddCommand :: Parser Command+parseAddCommand = Add .* AddOptions <$> folderParser <*> warpnameParser++folderParser :: Parser (Maybe String)+folderParser = optional $ strOption+    (long "path"+    <> short 'p'+    <> metavar "FOLDER"+    <> help "path to the folder to warp to")++parseRemoveCommand :: Parser Command+parseRemoveCommand = Remove . RemoveOptions <$> warpnameParser++parseGotoCommand :: Parser Command+parseGotoCommand = Goto . GotoOptions <$> warpnameParser++parseCommand :: Parser Command+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]    ++colorWhen :: IO () -> IO ()+colorWhen act = do+    useColor <- fromMaybe "1" <$> lookupEnv "CLICOLOR"+    if useColor /= "0" then act else pure def++warpPointPrint :: WarpPoint -> IO ()+warpPointPrint warpPoint = do+    colorWhen $ setSGR [SetColor Foreground Dull White]+    putStr (_name warpPoint)+    colorWhen $ setSGR [SetColor Foreground Vivid Blue]+    putStr $ "\t" <> _absFolderPath warpPoint <> "\n"++folderNotFoundError :: FilePath -> IO ()+folderNotFoundError path = setErrorColor >> +    (die . T.pack $ ("unable to find folder: " ++ show path))++needFolderNotFileError :: FilePath -> IO ()+needFolderNotFileError path = setErrorColor >>+    (die . T.pack $ "expected folder, not file: " ++ show path)++dieIfFolderNotFound :: FilePath -> IO ()+dieIfFolderNotFound path = foldr (>>) (pure def)+    [ flip when (needFolderNotFileError path) =<< testfile path+    , flip unless (folderNotFoundError path) =<< testdir path ]++dieWarpPointExists :: WarpPoint -> IO ()+dieWarpPointExists warpPoint  = foldr (>>) (pure def) +    [ setErrorColor+    , putStrLn $ "warp point " <> _name warpPoint <> " already exists:\n"+    , warpPointPrint warpPoint ]++runAdd :: AddOptions -> IO ()+runAdd AddOptions{..} = do+    dieIfFolderNotFound . P.decode . encodeUtf8 . T.pack . fromMaybe "./" $ folderPath+    print "folder exists, loading warp data..."+    warpData <- loadWarpData =<< warpDataPath+    _absFolderPath <- realpath . P.decode . encodeUtf8 . T.pack . 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 = def & name .~ addname & absFolderPath .~ 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")++runRemove :: RemoveOptions -> IO ()+runRemove RemoveOptions{..} = do+    warpPath <- warpDataPath+    warp <- loadWarpData warpPath+    let wantedWarpPoint = find ((/= removename) . _name) (_warpPoints warp)+    case wantedWarpPoint of+        Nothing -> dieWarpPointNotFound removename+        Just _ -> saveWarpData warpPath +            (over warpPoints (filter ((/= removename) . _name)) warp)++runGoto :: GotoOptions -> IO ()+runGoto GotoOptions{..} = do+    warpPath <- warpDataPath+    warp <- loadWarpData warpPath+    let wantedWarpPoint = find ((== gotoname) . _name) (_warpPoints warp)+    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)+      +run :: Command -> IO ()+run (Add addOpt) = runAdd addOpt+run Display = runDisplay+run (Remove removeOpt) = runRemove removeOpt+run (Goto gotoOpt) = runGoto gotoOpt

@@ -0,0 +1,6 @@+resolver: lts-8.13+packages:+- '.'+extra-deps: []+flags: {}+extra-package-dbs: []