module Utils.PastePipe where
import Control.Monad (when)
import Data.Maybe
import Network.Browser
import Network.HTTP.Base
import Network.URI
import System.Console.CmdArgs
import System.Environment (getEnv)
data Config = Config { userName :: String
, language :: String
, channel :: String
, title :: String
, uri :: String
, private :: Bool
, test :: Bool
}
deriving (Show, Data, Typeable)
config :: String -> Config
config realUser = Config
{ userName = realUser
&= help "Your user name"
&= typ "USER"
&= explicit
&= name "user"
, language = "haskell"
&= help "The language used for syntax highlighting"
&= typ "LANGUAGE"
, channel = ""
&= help "#channel to post your snippet. The lpaste bot will not post the message if you do not set --title=TITLE and --user=<YOUR NICK>"
&= typ "#channel-name"
&= name "channel"
&= name "c"
, title = ""
&= help "The title of the snippet"
&= typ "TITLE"
&= explicit
&= name "title"
&= name "t"
, uri = defaultUri
&= help "The URI of the lpaste instance to post to"
&= typ "URL"
, private = False
&= help "Make this a private snippet, off by default"
, test = False
&= help "Prevents PastePipe from actually posting content, just echos the configuration and input"
}
&= summary "PastePipe v1.8, (C) Rogan Creswick 2009-2012, (C) Mateusz Kowalczyk 2014-2015"
&= program "pastepipe"
postWithDefaults :: String -> IO URI
postWithDefaults s = getEnv "USER" >>= \u -> post (config u) s
outHandler :: String -> IO ()
outHandler str = do
loud <- isLoud
when loud $ putStr str
defaultUri :: String
defaultUri = "http://lpaste.net/"
saveUri :: String -> URI
saveUri coreUri = buildURI coreUri "new"
buildURI :: String -> String -> URI
buildURI coreUri str = fromJust $ parseURI $ coreUri ++ str
post :: Config -> String -> IO URI
post conf str = do
(url, _) <- Network.Browser.browse $ do
setOutHandler outHandler
setAllowRedirects True
request $ buildRequest conf str
return url
mkPrivatePair :: Config -> (String, String)
mkPrivatePair conf | private conf = ("private", "Private")
| otherwise = ("public", "Public")
buildRequest :: Config -> String -> Request String
buildRequest conf str = formToRequest $ Form POST (saveUri $ uri conf)
[ ("title", title conf)
, ("author", userName conf)
, ("paste", str)
, ("language", language conf)
, ("channel", channel conf)
, mkPrivatePair conf
, ("email", "")
]
fakePost :: Config -> String -> IO URI
fakePost conf str = do
putStrLn $ "uri: "++uri conf
putStrLn $ "user: "++userName conf
putStrLn $ "lang: "++language conf
putStrLn $ "chan: "++channel conf
putStrLn $ "title: "++title conf
putStrLn $ "content: "++str
putStrLn $ (\(p, p') -> p ++ ":" ++ p') (mkPrivatePair conf)
return $ fromJust $ parseURI $ uri conf