diff --git a/HPasteIt.hs b/HPasteIt.hs --- a/HPasteIt.hs +++ b/HPasteIt.hs @@ -1,124 +1,52 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Data.Char -import Data.Monoid +import ProgOpts (ProgOpts(..), parseOpts) + +import Data.Maybe +import System.Directory +import System.Environment import System.Exit import System.IO import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as LBS import Control.Exception.Lifted import Network.HTTP.Conduit import Network.HTTP.Types import Options.Applicative - -data Options = Options - { optTitle :: String - , optAuthor :: String - , optLanguage :: String - , optChannel :: String - , optFile :: FilePath - } - -optParser :: Parser Options -optParser = Options - <$> nullOption (mconcat [ reader Right - , value "via HPasteIt" - , short 't' - , long "title" - , metavar "TITLE" - , help "The title of the paste; \ - \defaults to \"via HPasteIt\"." - ]) - - <*> nullOption (mconcat [ reader Right - , value "Anonymous" - , short 'a' - , long "author" - , metavar "AUTHOR" - , help "The author of the paste; \ - \defaults to \"Anonymous\"." - ]) - - <*> nullOption (mconcat [ reader (readLanguage . map toLower) - , long "language" - , short 'l' - , metavar "LANGUAGE" - , value "haskell" - , help "The language of the paste; \ - \defaults to Haskell." - ]) - - <*> nullOption (mconcat [ reader (readChannel . map toLower) - , long "channel" - , short 'c' - , metavar "CHANNEL" - , value "" - , help "The IRC channel to notify." - ]) - - <*> argument Just (mconcat [ metavar "FILE" - , value "-" - , help "The path of the file to paste; \ - \defaults to - for STDIN." - ]) - where - -- The string arguments of these functions are lower-case. - - readLanguage :: String -> Either ParseError String - readLanguage lang - | Just real_lang <- lookup lang suffixes = Right real_lang - | lang `elem` langs = Right lang - | otherwise = Left (ErrorMsg err_msg) - where - suffixes = [ ("hs" , "haskell" ) - , ("lhs", "literatehaskell") - ] - - -- Not an exhaustive list. - langs = ["haskell","agda","ocaml","lisp","erlang","literatehaskell" - ] - - err_msg = "Invalid language. See hpaste.org for a full list of \ - \supported languages." - - readChannel :: String -> Either ParseError String - readChannel chan - = if dropWhile (=='#') chan `elem` chans - then Right chan - else Left (ErrorMsg err_msg) - where - -- Not an exhaustive list. - chans = ["haskell"] - - err_msg = "Invalid IRC channel. See hpaste.org for a full list of \ - \valid IRC channels." - +import System.Cmd main :: IO () -main = do - options <- execParser $ info (helper <*> optParser) $ - mconcat [ fullDesc - , header "hpasteit - command-line client for hpaste.org" - ] +main = parseOpts >>= realMain - paste <- case optFile options of +realMain :: ProgOpts -> IO () +realMain PasteOpts + { optFile = opt_file + , optTitle = opt_title + , optAuthor = opt_author + , optLanguage = opt_language + , optChannel = opt_channel + } + = do + paste <- case opt_file of "-" -> BS.getContents file -> BS.readFile file res <- withManager $ \man -> try $ do rq <- parseUrl "http://hpaste.org/new" let rq' = urlEncodedBody - [ ("title" , BS.pack $ optTitle options) - , ("author" , BS.pack $ optAuthor options) - , ("language", BS.pack $ optLanguage options) - , ("channel" , BS.pack $ optChannel options) - , ("paste" , paste ) - , ("email" , "" ) + [ ("title" , BS.pack opt_title ) + , ("author" , BS.pack opt_author ) + , ("language", BS.pack opt_language) + , ("channel" , BS.pack opt_channel ) + , ("paste" , paste ) + , ("email" , "" ) ] rq - -- In order to grab the URL of the paste we don't follow redirects. + -- hpaste.org redirects us to the URL of the paste if pasting succeeds. + -- In order to grab the URL we explicitly don't follow redirects. httpLbs (rq' { redirectCount = 0 }) man case res of @@ -140,3 +68,45 @@ hPutStrLn stderr "Encountered unexpected response:\n" hPutStrLn stderr (show resp) exitFailure + +realMain ViewOpts + { optPasteID = opt_paste_id } + = do + res <- withManager $ \man -> try $ do + rq <- parseUrl ("http://hpaste.org/raw/" ++ show opt_paste_id) + + httpLbs (rq { redirectCount = 0}) man + + case res of + Left (StatusCodeException (Status 302 _) hdrs) + | Just "/" <- lookup "Location" hdrs -> do + + hPutStrLn stderr $ + "Paste #" ++ show opt_paste_id ++ " does not exist" + exitFailure + + Left exc -> do + + hPutStrLn stderr "Encountered unexpected HttpException:\n" + hPutStrLn stderr (show (exc :: HttpException)) + exitFailure + + Right resp -> do + tmp_dir <- getTemporaryDirectory + withTempFile tmp_dir "hpasteit" $ \hdl file -> do + + LBS.hPutStrLn hdl (responseBody resp) + hFlush hdl + + editor <- fromMaybe "vi" <$> lookupEnv "EDITOR" + exit_code <- rawSystem editor [file] + + exitWith exit_code + + where + withTempFile :: FilePath -> String + -> (Handle -> FilePath -> IO a) + -> IO a + withTempFile tmp_dir prefix thing = do + (file,hdl) <- openTempFile tmp_dir prefix + thing hdl file `finally` (hClose hdl `finally` removeFile file) diff --git a/hpasteit.cabal b/hpasteit.cabal --- a/hpasteit.cabal +++ b/hpasteit.cabal @@ -1,7 +1,6 @@ name: hpasteit -version: 0.1.0.0 +version: 0.2.0.0 synopsis: A command-line client for hpaste.org --- description: license: BSD3 license-file: LICENSE author: Patrick Palka @@ -14,6 +13,11 @@ stability: provisional homepage: http://github.com/parcs/hpasteit bug-reports: http://github.com/parcs/hpasteit/issues +description: + HPasteIt is a command-line client for hpaste.org + . + Run @hpaste --help@ for usage information and @hpaste COMMAND --help@ for detailed + usage information for a particular command. source-repository head type: git @@ -28,6 +32,9 @@ , http-conduit ==1.8.* , http-types ==0.7.* , optparse-applicative ==0.5.* + , process ==1.1.* + , network ==2.4.* + , directory ==1.2.* ghc-options: -Wall