PastePipe 1.0 → 1.1

raw patch · 2 files changed

+56/−25 lines, 2 files

Files

PastePipe.cabal +6/−4
pastepipe.hs +50/−21

PastePipe.cabal view

@@ -1,15 +1,17 @@ -- cabal configure --prefix=$HOME --user -- cabal build name:                PastePipe-version:             1.0+version:             1.1 synopsis:            CLI for pasting to hpaste.org description:         PastePipe reads from standard in and posts to hpaste.org.-							It will auto-detect your username, but that can be -							overridden with command line options (-u username)-							Titles are set with -t, language with -l.+                     It will auto-detect your username, but that can be +                     overridden with command line options (-u username)+                     Titles are set with -t, language with -l. category:            Utils license:             GPL License-file:        LICENSE+homepage:            http://pastepipe.googlecode.com/+bug-reports:         http://code.google.com/p/pastepipe/issues/list author:              Rogan Creswick maintainer:          creswick@gmail.com Cabal-Version:       >=1.2

pastepipe.hs view

@@ -32,53 +32,59 @@ --   http://hpaste.org/fastcgi/hpaste.fcgi/help  -- | The "root" uri for hpaste.org-coreUri :: String -coreUri = "http://hpaste.org/fastcgi/hpaste.fcgi/"+defaultUri :: String +defaultUri = "http://hpaste.org/fastcgi/hpaste.fcgi/"  -- | The URI for posting new pastes to hpaste. -- This isn't guaranteed to trigger a failure on all execution paths, as-is.-saveUri :: URI-saveUri = buildURI "save"+saveUri :: String -> URI+saveUri coreUri = buildURI coreUri "save"  -- | composes the core uri and a string to create a usable URI-buildURI :: String -> URI-buildURI str = fromJust $ parseURI $ coreUri ++ str+buildURI :: String -> String -> URI+buildURI coreUri str = fromJust $ parseURI $ coreUri ++ str  -- | Posts the given content to hpaste.org, returning the new uri.-post :: String -> String -> String -> String -> IO URI-post usr lang title str = do +post :: URI -> String -> String -> String -> String -> IO URI+post posturi usr lang title str = do    (uri, _) <- Network.Browser.browse $ do                   setAllowRedirects True -- handle HTTP redirects-                  request $ buildRequest usr lang title str+                  request $ buildRequest posturi usr lang title str   return uri  -- | Creates the request to post a chunk of content.-buildRequest :: String -> String -> String -> String -> Request String-buildRequest usr lang title str = formToRequest $ Form POST saveUri +buildRequest :: URI -> String -> String -> String -> String -> Request String+buildRequest uri usr lang title str = formToRequest $ Form POST uri                               [ ("title", title)                              , ("author", usr)                              , ("content", str)                              , ("language", lang)                              , ("channel", "")] -fakePost ::  String -> String -> String -> String -> IO URI-fakePost usr lang title str = do +fakePost ::  URI -> String -> String -> String -> String -> IO URI+fakePost uri usr lang title str = do +  putStrLn $ "uri: "++show uri   putStrLn $ "user: "++usr   putStrLn $ "lang: "++lang   putStrLn $ "title: "++title   putStrLn $ "content: "++str-  return saveUri+  return uri  main :: IO ()  main = do   args <- getArgs-  content <- getContents-  realUser <- getEnv "USER"-  let usr = getArgVal "-u" realUser args-      lang = getLang args-      title = getTitle args-  uri <- post usr lang title content-  putStrLn $ show uri+  case (elem "--help" args) of +    True -> printHelp+    False -> do+         content <- getContents+         realUser <- getEnv "USER"+         let usr = getArgVal "-u" realUser args+             lang = getLang args+             title = getTitle args+             coreUri = getCoreUri args+             postFn = getPostFn args+         uri <- postFn (saveUri coreUri) usr lang title content+         putStrLn $ show uri  -- | Determines the language from the list of arguments. getLang :: [String] -> String@@ -86,6 +92,29 @@  getTitle :: [String] -> String getTitle = getArgVal "-t" ""++getCoreUri :: [String] -> String+getCoreUri = getArgVal "--uri" defaultUri++getPostFn :: [String] -> URI -> String -> String -> String -> String -> IO URI+getPostFn args = case (getArgVal "--test" "testFn" args) of+                   "testFn"  -> fakePost+                   _         -> post++                 +-- | Prints the usage information.+printHelp :: IO ()+printHelp = do+    putStrLn "Usage: pastepipe --uri <url> -u <user> -t <title> -l <language> --test"+    putStrLn ""+    putStrLn "  eg: pastepipe --uri \"http://hpaste.org/fastcgi/hpaste.fcgi/\" -t \"new post\""+    putStrLn ""+    putStrLn " -t <title>          Defaults to \"\""+    putStrLn " -u <username>       Defaults to ${USER}"+    putStrLn " -l <language>       Defaults to haskell"+    putStrLn $ " --uri <hpaste_uri>  Defaults to "++ defaultUri+    putStrLn " --test              Fake the post--does not send anything to the server (used for testing)"+  -- | given a flag and a default value, returns the first  -- argument following the first instance fo flag, or the default