diff --git a/exe-src/Main.hs b/exe-src/Main.hs new file mode 100644 --- /dev/null +++ b/exe-src/Main.hs @@ -0,0 +1,54 @@ +----------------------------------------------------------------------------- +-- +-- Module : Main +-- Copyright : Hamish Mackenzie +-- License : MIT +-- +-- Maintainer : Hamish Mackenzie +-- Stability : Experimental +-- Portability : Unknown +-- +-- | Lets you quickly run ssh on a machine that you have an sshfs connection +-- to. It works out the username, host and the directory on the host based +-- on the current directory and the output of 'mount' +-- +----------------------------------------------------------------------------- + +module Main ( + main +) where + +import System.IO (hPutStrLn, stderr) +import System.Directory (getCurrentDirectory) +import System.Environment (getArgs) +import Data.List (isPrefixOf) +import System.Exit (exitWith, ExitCode(..)) +import System.Process (rawSystem) +import System.Process.Vado (getMountPoint, vado, readSettings, defMountSettings) + +-- | Main function for vado +main = do + args <- getArgs + case span ("-" `isPrefixOf`) args of + (sshopts,cmd:rest) -> do + currentDir <- getCurrentDirectory + mbMountPoint <- getMountPoint currentDir + ms <- readSettings + case mbMountPoint of + Left mp -> vado mp ms currentDir sshopts cmd rest + >>= rawSystem "ssh" >>= exitWith + Right err -> hPutStrLn stderr err >> (exitWith $ ExitFailure 1) + _ -> do + defSettings <- defMountSettings + hPutStrLn stderr $ + "Usage vado [ssh options] command [args]\n\n" + + ++ "The command will be run in the directoy on the remote\n" + ++ "machine that corrisponds to the current directory locally.\n\n" + + ++ "The ssh options must start with a dash '-'.\n" + ++ "You can specify port and key location settings\n" + ++ "in the ~/.vadosettings file.\nExample contents:\n" + ++ show [defSettings] + exitWith $ ExitFailure 1 + diff --git a/exe-src/Test.hs b/exe-src/Test.hs new file mode 100644 --- /dev/null +++ b/exe-src/Test.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +----------------------------------------------------------------------------- +-- +-- Module : Main (for tests) +-- Copyright : Hamish Mackenzie +-- License : BSD +-- +-- Maintainer : Hamish Mackenzie +-- Stability : Experimental +-- Portability : Unknown +-- +-- | +-- +----------------------------------------------------------------------------- + +module Main ( + main +) where + +import Control.Monad (unless) +import Control.Applicative ((<$>)) +import System.Exit (exitFailure) +import Test.QuickCheck (Arbitrary(..), elements, listOf1) +import Test.QuickCheck.All (quickCheckAll) +import Data.Text (pack) +import System.Process.Vado (MountPoint(..), parseMountPoint) + +instance Arbitrary MountPoint where + arbitrary = do + let nameChars = ['A'..'Z'] ++ ['a' .. 'z'] ++ ['0'..'1'] ++ "_." + remoteUser <- pack <$> listOf1 (elements nameChars) + remoteHost <- pack <$> listOf1 (elements nameChars) + remoteDir <- listOf1 (elements $ '/':nameChars) + localDir <- listOf1 (elements $ '/':nameChars) + return MountPoint{..} + +prop_MountPointParses mp = parseMountPoint (show mp) == Just mp + +-- | Entry point for unit tests. +main = do + allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions + unless allPass exitFailure + diff --git a/exe-src/Vamount.hs b/exe-src/Vamount.hs new file mode 100644 --- /dev/null +++ b/exe-src/Vamount.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- +-- Module : Main +-- Copyright : Hamish Mackenzie & Dan Frumin +-- License : MIT +-- +-- Maintainer : Hamish Mackenzie +-- Stability : Experimental +-- Portability : Unknown +-- +-- | Lets you quickly mount sshfs file systems based on .vadosettings files, +-- for future use with 'vado' +-- +----------------------------------------------------------------------------- + +module Main ( + main +) where + +import Control.Monad (when) +import System.IO (hPutStrLn, stderr) +import System.Directory (getCurrentDirectory) +import System.Environment (getArgs) +import Data.List (isPrefixOf) +import Data.Maybe (fromMaybe) +import System.Exit (exitWith, ExitCode(..)) +import System.Process (rawSystem) +import System.Process.Vado (getMountPoint, vado, + readSettings, defMountSettings, vamount) +#if MIN_VERSION_base(4,6,0) +import Text.Read (readMaybe) +#else +import Text.Read (reads) +#endif + +#if !MIN_VERSION_base(4,6,0) +-- | Parse a string using the 'Read' instance. +-- Succeeds if there is exactly one valid result. +readMaybe :: Read a => String -> Maybe a +readMaybe s = case reads s of + [(x, "")] -> Just x + _ -> Nothing +#endif + +-- | Main function for vamount +main = do + args <- getArgs + case span ("-" `isPrefixOf`) args of + (sshfsopts,path:rest) -> do + currentDir <- getCurrentDirectory + ms <- readSettings + defSettings <- defMountSettings + let profileNum + | null rest = 0 + | otherwise = fromMaybe 0 (readMaybe (head rest)) + when (length ms < profileNum || profileNum < 0) printUsage + let profile = if profileNum == 0 + then defSettings + else ms !! (profileNum - 1) + rawSystem "sshfs" (vamount profile path currentDir sshfsopts) + >>= exitWith + _ -> printUsage + +printUsage :: IO () +printUsage = do + defSettings <- defMountSettings + hPutStrLn stderr $ + "Usage vamount [ssh options] remote_path [profile #]\n\n" + ++ "The remote_path from the remote server specified\n" + ++ "in the ~/.vadosettings file under number [profile #]\n" + ++ "will be mounted in the current directory using sshfs\n\n" + ++ "The ssh options must start with a dash '-'.\n" + ++ "The profile number count starts from 1.\n" + ++ "If the [profile #] is absent or is 0 then \n" + ++ "the default configuration will be used:\n" + ++ show [defSettings] + exitWith $ ExitFailure 1 + diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,54 +0,0 @@ ------------------------------------------------------------------------------ --- --- Module : Main --- Copyright : Hamish Mackenzie --- License : MIT --- --- Maintainer : Hamish Mackenzie --- Stability : Experimental --- Portability : Unknown --- --- | Lets you quickly run ssh on a machine that you have an sshfs connection --- to. It works out the username, host and the directory on the host based --- on the current directory and the output of 'mount' --- ------------------------------------------------------------------------------ - -module Main ( - main -) where - -import System.IO (hPutStrLn, stderr) -import System.Directory (getCurrentDirectory) -import System.Environment (getArgs) -import Data.List (isPrefixOf) -import System.Exit (exitWith, ExitCode(..)) -import System.Process (rawSystem) -import System.Process.Vado (getMountPoint, vado, readSettings, defMountSettings) - --- | Main function for vado -main = do - args <- getArgs - case span ("-" `isPrefixOf`) args of - (sshopts,cmd:rest) -> do - currentDir <- getCurrentDirectory - mbMountPoint <- getMountPoint currentDir - ms <- readSettings - case mbMountPoint of - Left mp -> vado mp ms currentDir sshopts cmd rest - >>= rawSystem "ssh" >>= exitWith - Right err -> hPutStrLn stderr err >> (exitWith $ ExitFailure 1) - _ -> do - defSettings <- defMountSettings - hPutStrLn stderr $ - "Usage vado [ssh options] command [args]\n\n" - - ++ "The command will be run in the directoy on the remote\n" - ++ "machine that corrisponds to the current directory locally.\n\n" - - ++ "The ssh options must start with a dash '-'.\n" - ++ "You can specify port and key location settings\n" - ++ "in the ~/.vadosettings file.\nExample contents:\n" - ++ show [defSettings] - exitWith $ ExitFailure 1 - diff --git a/src/Test.hs b/src/Test.hs deleted file mode 100644 --- a/src/Test.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE RecordWildCards #-} ------------------------------------------------------------------------------ --- --- Module : Main (for tests) --- Copyright : Hamish Mackenzie --- License : BSD --- --- Maintainer : Hamish Mackenzie --- Stability : Experimental --- Portability : Unknown --- --- | --- ------------------------------------------------------------------------------ - -module Main ( - main -) where - -import Control.Monad (unless) -import Control.Applicative ((<$>)) -import System.Exit (exitFailure) -import Test.QuickCheck (Arbitrary(..), elements, listOf1) -import Test.QuickCheck.All (quickCheckAll) -import Data.Text (pack) -import System.Process.Vado (MountPoint(..), parseMountPoint) - -instance Arbitrary MountPoint where - arbitrary = do - let nameChars = ['A'..'Z'] ++ ['a' .. 'z'] ++ ['0'..'1'] ++ "_." - remoteUser <- pack <$> listOf1 (elements nameChars) - remoteHost <- pack <$> listOf1 (elements nameChars) - remoteDir <- listOf1 (elements $ '/':nameChars) - localDir <- listOf1 (elements $ '/':nameChars) - return MountPoint{..} - -prop_MountPointParses mp = parseMountPoint (show mp) == Just mp - --- | Entry point for unit tests. -main = do - allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions - unless allPass exitFailure - diff --git a/src/Vamount.hs b/src/Vamount.hs deleted file mode 100644 --- a/src/Vamount.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- --- Module : Main --- Copyright : Hamish Mackenzie & Dan Frumin --- License : MIT --- --- Maintainer : Hamish Mackenzie --- Stability : Experimental --- Portability : Unknown --- --- | Lets you quickly mount sshfs file systems based on .vadosettings files, --- for future use with 'vado' --- ------------------------------------------------------------------------------ - -module Main ( - main -) where - -import Control.Monad (when) -import System.IO (hPutStrLn, stderr) -import System.Directory (getCurrentDirectory) -import System.Environment (getArgs) -import Data.List (isPrefixOf) -import Data.Maybe (fromMaybe) -import System.Exit (exitWith, ExitCode(..)) -import System.Process (rawSystem) -import System.Process.Vado (getMountPoint, vado, - readSettings, defMountSettings, vamount) -#if MIN_VERSION_base(4,6,0) -import Text.Read (readMaybe) -#else -import Text.Read (reads) -#endif - -#if !MIN_VERSION_base(4,6,0) --- | Parse a string using the 'Read' instance. --- Succeeds if there is exactly one valid result. -readMaybe :: Read a => String -> Maybe a -readMaybe s = case reads s of - [(x, "")] -> Just x - _ -> Nothing -#endif - --- | Main function for vamount -main = do - args <- getArgs - case span ("-" `isPrefixOf`) args of - (sshfsopts,path:rest) -> do - currentDir <- getCurrentDirectory - ms <- readSettings - defSettings <- defMountSettings - let profileNum - | null rest = 0 - | otherwise = fromMaybe 0 (readMaybe (head rest)) - when (length ms < profileNum || profileNum < 0) printUsage - let profile = if profileNum == 0 - then defSettings - else ms !! (profileNum - 1) - rawSystem "sshfs" (vamount profile path currentDir sshfsopts) - >>= exitWith - _ -> printUsage - -printUsage :: IO () -printUsage = do - defSettings <- defMountSettings - hPutStrLn stderr $ - "Usage vamount [ssh options] remote_path [profile #]\n\n" - ++ "The remote_path from the remote server specified\n" - ++ "in the ~/.vadosettings file under number [profile #]\n" - ++ "will be mounted in the current directory using sshfs\n\n" - ++ "The ssh options must start with a dash '-'.\n" - ++ "The profile number count starts from 1.\n" - ++ "If the [profile #] is absent or is 0 then \n" - ++ "the default configuration will be used:\n" - ++ show [defSettings] - exitWith $ ExitFailure 1 - diff --git a/vado.cabal b/vado.cabal --- a/vado.cabal +++ b/vado.cabal @@ -1,6 +1,6 @@ +cabal-version: 3.0 name: vado -version: 0.0.12 -cabal-version: >=1.8 +version: 0.0.13 build-type: Simple license: MIT license-file: LICENSE @@ -18,37 +18,40 @@ location: https://github.com/hamishmack/vado.git library - build-depends: base >=4.0.0.0 && <4.14, attoparsec >=0.10.4.0 && <0.14, + build-depends: base >=4.0.0.0 && <4.15, attoparsec >=0.10.4.0 && <0.14, directory >=1.1.0.0 && <1.4, filepath >=1.2.0.0 && <1.5, process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3 exposed-modules: System.Process.Vado exposed: True buildable: True hs-source-dirs: src + default-language: Haskell2010 executable vado - build-depends: base >=4.0.0.0 && <4.14, attoparsec >=0.10.4.0 && <0.14, + build-depends: base >=4.0.0.0 && <4.15, attoparsec >=0.10.4.0 && <0.14, directory >=1.1.0.0 && <1.4, filepath >=1.2.0.0 && <1.5, - process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3 + process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3, vado main-is: Main.hs buildable: True - hs-source-dirs: src - other-modules: System.Process.Vado + hs-source-dirs: exe-src + default-language: Haskell2010 executable vamount - build-depends: base >=4.0.0.0 && <4.14, attoparsec >=0.10.4.0 && <0.14, + build-depends: base >=4.0.0.0 && <4.15, attoparsec >=0.10.4.0 && <0.14, directory >=1.1.0.0 && <1.4, filepath >=1.2.0.0 && <1.5, - process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3 + process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3, vado main-is: Vamount.hs buildable: True - hs-source-dirs: src - other-modules: System.Process.Vado + hs-source-dirs: exe-src + default-language: Haskell2010 test-suite test-vado - build-depends: base >=4.0.0.0 && <4.14, QuickCheck -any, attoparsec >=0.10.4.0 && <0.14, + build-depends: base >=4.0.0.0 && <4.15, QuickCheck -any, attoparsec >=0.10.4.0 && <0.14, directory >=1.1.0.0 && <1.4, filepath >=1.2.0.0 && <1.5, - process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3 + process >=1.0.1.5 && <1.7, text >=0.11.3.1 && <1.3, vado type: exitcode-stdio-1.0 main-is: Test.hs buildable: True - hs-source-dirs: src + hs-source-dirs: exe-src + default-language: Haskell2010 +