hpasteit (empty) → 0.1.0.0
raw patch · 4 files changed
+208/−0 lines, 4 filesdep +basedep +bytestringdep +http-conduitsetup-changed
Dependencies added: base, bytestring, http-conduit, http-types, lifted-base, optparse-applicative
Files
- HPasteIt.hs +142/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- hpasteit.cabal +34/−0
+ HPasteIt.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Data.Char+import Data.Monoid+import System.Exit+import System.IO++import qualified Data.ByteString.Char8 as BS++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."+++main :: IO ()+main = do+ options <- execParser $ info (helper <*> optParser) $+ mconcat [ fullDesc+ , header "hpasteit - command-line client for hpaste.org"+ ]++ paste <- case optFile options 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" , "" )+ ] rq++ -- In order to grab the URL of the paste we don't follow redirects.+ httpLbs (rq' { redirectCount = 0 }) man++ case res of+ -- An exception is thrown if the server issues a redirect.+ Left (StatusCodeException (Status 302 _) hdrs)+ | Just loc <- lookup "Location" hdrs -> do++ putStrLn ("http://hpaste.org" ++ BS.unpack loc)+ exitSuccess++ Left exc -> do++ hPutStrLn stderr "Encountered unexpected HttpException:\n"+ hPutStrLn stderr (show exc)+ exitFailure++ Right resp -> do++ hPutStrLn stderr "Encountered unexpected response:\n"+ hPutStrLn stderr (show resp)+ exitFailure
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Patrick Palka++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 Patrick Palka 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
+ hpasteit.cabal view
@@ -0,0 +1,34 @@+name: hpasteit+version: 0.1.0.0+synopsis: A command-line client for hpaste.org+-- description: +license: BSD3+license-file: LICENSE+author: Patrick Palka+maintainer: patrick@parcs.ath.cx+copyright: Copyright (C) 2012 Patrick Palka+category: Web+build-type: Simple+cabal-version: >=1.8+tested-with: GHC == 7.6.1+stability: provisional+homepage: http://github.com/parcs/hpasteit+bug-reports: http://github.com/parcs/hpasteit/issues++source-repository head+ type: git+ location: git://github.com/parcs/hpasteit.git++executable hpasteit+ main-is: HPasteIt.hs++ build-depends: base ==4.6.*+ , bytestring ==0.10.*+ , lifted-base ==0.2.*+ , http-conduit ==1.8.*+ , http-types ==0.7.*+ , optparse-applicative ==0.5.*++ ghc-options: -Wall++ extensions: PatternGuards