hpasteit 0.1.0.0 → 0.2.0.0
raw patch · 2 files changed
+77/−100 lines, 2 filesdep +directorydep +networkdep +process
Dependencies added: directory, network, process
Files
- HPasteIt.hs +68/−98
- hpasteit.cabal +9/−2
HPasteIt.hs view
@@ -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)
hpasteit.cabal view
@@ -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