teleport (empty) → 0.0.0.9
raw patch · 6 files changed
+464/−0 lines, 6 filesdep +aesondep +ansi-terminaldep +basesetup-changed
Dependencies added: aeson, ansi-terminal, base, bytestring, configurator, optparse-applicative, system-filepath, text, turtle, warp-haskell
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +373/−0
- src/Lib.hs +6/−0
- teleport.cabal +51/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Siddharth Bhat (c) 2015++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,373 @@+--Copyright (c) 2015 Siddharth Bhat++--Permission is hereby granted, free of charge, to any person obtaining+--a copy of this software and associated documentation files (the "Software")+--to deal in the Software without restriction, including without limitation the+--rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+--sell copies of the Software, and to permit persons to whom the Software is+--furnished to do so, subject to the following conditions:++-- The above copyright notice and this permission notice shall+-- be included in all copies or substantial portions of the Software.++--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+--OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+--FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+--AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+--LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+--FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+--OTHER DEALINGS IN THE SOFTWARE.+++#!/usr/bin/env stack++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+++import Control.Monad+import Data.Traversable+import Data.Maybe+import Data.List++import Prelude hiding (FilePath)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T.Encoding++import Options.Applicative+import Filesystem.Path.CurrentOS as Path++import qualified Turtle+--import qualified Data.Configurator as Config++import qualified Data.Aeson as JSON+import Data.Aeson ((.=), (.:))++import qualified Data.ByteString.Lazy as B++import qualified System.Console.ANSI as ANSI+++import Debug.Trace++-- options passed to 'warp list'+data ListOptions = ListOptions deriving (Show)++-- options pased to 'warp add'+data AddOptions = AddOptions {+ folderPath :: FilePath,+ addname :: String+} deriving (Show)++-- options passed to 'warp remove'+data RemoveOptions = RemoveOptions {+ removename :: String+} deriving (Show)++-- options parrsed to 'warp goto'+data GotoOptions = GotoOptions {+ gotoname :: String+} deriving(Show)+-- the combined datatype representing all warp commands+data Command = CommandList ListOptions |+ CommandAdd AddOptions |+ CommandRemove RemoveOptions |+ CommandGoto GotoOptions+ deriving (Show)++-- an abstract entity representing a point to which we can warp to+data WarpPoint = WarpPoint {+ name :: String,+ absFolderPath :: String+} deriving (Show)+++-- the main data that is loaded from JSON +data WarpData = WarpData {+ warpPoints :: [WarpPoint]+} deriving (Show)++defaultWarpData :: WarpData+defaultWarpData = WarpData {+ warpPoints = []+}++-- flip function for ease of chaining computations+(|>) :: a -> (a -> b) -> b+(|>) = flip ($)+++filePathToString :: FilePath -> String+filePathToString = Path.encodeString++warpProgDesc :: String+warpProgDesc = "use warp to quickly setup warp points and move to these " +++ "when needed"++warpHeader :: String+warpHeader = "Warp: move around your filesystem"+++main :: IO ()+main = do + command <- execParser (info (helper <*> parseCommand)+ (fullDesc <>+ progDesc warpProgDesc <>+ header warpHeader))+ run command++-- Data Loading+-- """"""""""""++-- parse warpPoint+instance JSON.FromJSON WarpPoint where+ parseJSON (JSON.Object v) =+ WarpPoint <$> v .: "name"+ <*> v .: "absFolderPath"++instance JSON.ToJSON WarpPoint where+ toJSON (WarpPoint {..}) = + JSON.object [ "name" .= name+ ,"absFolderPath" .= absFolderPath]++-- parse warpData+instance JSON.FromJSON WarpData where+ parseJSON (JSON.Object v) =+ WarpData <$> v .: "warpPoints"++instance JSON.ToJSON WarpData where+ toJSON(WarpData{..}) = + JSON.object ["warpPoints" .= warpPoints]++dieJSONParseError :: FilePath -> String -> IO WarpData+dieJSONParseError jsonFilePath err = + ("parse error in: " ++ (show jsonFilePath) +++ "\nerror:------\n" ++ err) |>+ T.pack |>+ Turtle.die++decodeWarpData :: FilePath -> IO WarpData+decodeWarpData jsonFilePath = do+ rawInput <- B.readFile (filePathToString jsonFilePath)+ let jsonResult = JSON.eitherDecode' rawInput ++ case jsonResult of+ Left err -> dieJSONParseError jsonFilePath err+ Right json -> return json++createWarpDataFile :: FilePath -> IO ()+createWarpDataFile jsonFilePath = saveWarpData jsonFilePath defaultWarpData++loadWarpData :: FilePath -> IO WarpData+loadWarpData jsonFilePath = do+ exists <- (Turtle.testfile jsonFilePath)+ if exists then+ decodeWarpData jsonFilePath+ else+ do+ createWarpDataFile jsonFilePath+ return defaultWarpData++saveWarpData :: FilePath -> WarpData -> IO ()+saveWarpData jsonFilePath warpData = do+ let dataBytestring = JSON.encode warpData+ Turtle.touch jsonFilePath+ B.writeFile (filePathToString jsonFilePath) dataBytestring+++getWarpDataPath :: IO FilePath+getWarpDataPath = do+ homeFolder <- Turtle.home+ return $ homeFolder </> ".warpdata"+-- Common parsers+-- """"""""""""""+readFolderPath :: String -> ReadM FilePath+readFolderPath s = T.pack s |> + Path.fromText |> + (\path -> if Path.valid path+ then return path+ else readerError ("invalid path: " ++ (show path)))+++warpnameParser :: Parser String+warpnameParser = argument str+ (metavar "NAME" <>+ help "name of the warp point for usage")+++-- Command parsers+-- """""""""""""""++parseAddCommand :: Parser Command+parseAddCommand = + CommandAdd <$> (AddOptions <$> folderParser <*> warpnameParser) where+ folderParser = option+ (str >>= readFolderPath)+ --(long "path" <>+ --short 'p' <>+ (value "./" <>+ metavar "FOLDERPATH" <>+ help "path of the warp folder to warp to")++parseListCommand :: Parser Command+parseListCommand = pure (CommandList ListOptions)++parseRemoveCommand :: Parser Command+parseRemoveCommand = CommandRemove <$> (RemoveOptions <$> warpnameParser)++parseGotoCommand :: Parser Command+parseGotoCommand = CommandGoto <$> (GotoOptions <$> warpnameParser)++parseCommand :: Parser Command+parseCommand = subparser + -- add command+ ((command "add" (info parseAddCommand (progDesc "add a warp point"))) <>+ -- list command+ (command "list"+ (info parseListCommand (progDesc "list all warp points"))) <>+ -- remove command+ (command "remove"+ (info parseRemoveCommand (progDesc "remove a warp point"))) <>+ -- goto command+ (command "goto"+ (info parseGotoCommand (progDesc "go to a created warp point"))))++-- Stream Helpers+-- """"""""""""""++setErrorColor :: IO ()+setErrorColor = ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] +++warpPointPrint :: WarpPoint -> IO ()+warpPointPrint warpPoint = do+ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White] + putStr (name warpPoint)+ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue] + putStr "\t"+ putStr (absFolderPath warpPoint)+ putStr "\n"++-- Add command runner+-- """"""""""""""""""++folderNotFoundError :: FilePath -> IO ()+folderNotFoundError path =+ setErrorColor >> + ("unable to find folder: " ++ (show path)) |>+ T.pack |>+ Turtle.die++needFolderNotFileError :: FilePath -> IO ()+needFolderNotFileError path = + setErrorColor >>+ ("expected folder, not file: " ++ (show path)) |>+ T.pack |>+ Turtle.die++dieIfFolderNotFound :: FilePath -> IO ()+dieIfFolderNotFound path = + do+ folderExists <- Turtle.testdir path+ fileExists <- Turtle.testfile path+ -- error checking+ when fileExists (needFolderNotFileError path)+ unless folderExists (folderNotFoundError path)+ -- we know the folder exists++dieWarpPointExists :: WarpPoint -> IO ()+dieWarpPointExists warpPoint = do+ setErrorColor+ putStrLn ("warp point " ++ (name warpPoint) ++ " already exists:\n")+ warpPointPrint warpPoint+ Turtle.die ""++runAdd :: AddOptions -> IO ()+runAdd AddOptions{..} = do+ dieIfFolderNotFound folderPath+ print "yay, folder exists"+ print "loding warp data"+ + warpDataPath <- getWarpDataPath+ warpData <- loadWarpData warpDataPath+ absFolderPath <- Turtle.realpath folderPath+ + let existingWarpPoint = find (\warp -> name warp == addname) (warpPoints warpData)+ case existingWarpPoint of+ Just warpPoint -> dieWarpPointExists warpPoint+ Nothing -> do+ let newWarpPoint = WarpPoint {+ name = addname,+ absFolderPath = filePathToString absFolderPath+ }+ + putStrLn "creating warp point: \n"+ warpPointPrint newWarpPoint++ let newWarpData = WarpData {+ warpPoints = newWarpPoint:(warpPoints warpData) + }+ ++ saveWarpData warpDataPath newWarpData+ +-- List Command+-- """"""""""""+++runList :: ListOptions -> IO ()+runList ListOptions = do+ warpDataPath <- getWarpDataPath+ warpData <- loadWarpData warpDataPath++ forM_ (warpPoints warpData) warpPointPrint+ ++-- Remove Command+-- """""""""""""""++dieWarpPointNotFound :: String ->IO ()+dieWarpPointNotFound name = + setErrorColor >>+ (name ++ " warp point not found") |>+ T.pack |>+ Turtle.die++runRemove :: RemoveOptions -> IO ()+runRemove RemoveOptions{..} = do+ warpDataPath <- getWarpDataPath+ warpData <- loadWarpData warpDataPath+++ let wantedWarpPoint = find (\warp -> name warp == removename) (warpPoints warpData)+ case wantedWarpPoint of+ Nothing -> dieWarpPointNotFound removename+ Just _ -> do+ let newWarpPoints = filter (\warp -> name warp /= removename)+ (warpPoints warpData)+ let newWarpData = warpData {+ warpPoints = newWarpPoints+ }++ saveWarpData warpDataPath newWarpData++runGoto :: GotoOptions -> IO ()+runGoto GotoOptions{..} = do+ warpDataPath <- getWarpDataPath+ warpData <- loadWarpData warpDataPath+ + let wantedWarpPoint = find (\warp -> name warp == gotoname) (warpPoints warpData)+ case wantedWarpPoint of+ Nothing -> dieWarpPointNotFound gotoname+ Just warpPoint -> do+ Turtle.echo (T.pack (absFolderPath warpPoint))+ Turtle.exit (Turtle.ExitFailure 2) + +run :: Command -> IO ()+run command = + case command of+ CommandAdd addOpt -> runAdd addOpt+ CommandList listOpt -> runList listOpt+ CommandRemove removeOpt -> runRemove removeOpt+ CommandGoto gotoOpt -> runGoto gotoOpt+ other @ _ -> print other
+ src/Lib.hs view
@@ -0,0 +1,6 @@+module Lib+ ( someFunc+ ) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"
+ teleport.cabal view
@@ -0,0 +1,51 @@+name: teleport+version: 0.0.0.9+synopsis: A tool to quickly switch between directories+description: Please see README.md+homepage: https://github.com/bollu/teleport#readme+license: MIT+license-file: LICENSE+author: Siddharth Bhat+maintainer: siddu.druid@gmail.com+copyright: 2010 Siddharth Bhat+category: Tools+build-type: Simple+bug-reports: https://github.com/bollu/teleport/issues +stability: Alpha+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Lib+ build-depends: base >= 4.7 && < 5+ default-language: Haskell2010++executable warp-haskell-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , warp-haskell+ , turtle+ , optparse-applicative+ , system-filepath+ , text+ , configurator+ , aeson+ , bytestring+ , ansi-terminal+ default-language: Haskell2010++test-suite warp-haskell-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , warp-haskell+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/bollu/warp-haskell
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"