codepad (empty) → 0.1
raw patch · 4 files changed
+181/−0 lines, 4 filesdep +basedep +curldep +mtlsetup-changed
Dependencies added: base, curl, mtl, network, tagsoup
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Web/Codepad.hs +127/−0
- codepad.cabal +22/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Chris Done++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 Chris Done 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
+ Web/Codepad.hs view
@@ -0,0 +1,127 @@+-- | Simple pasting API for CodePad.org.+module Web.Codepad where++import Control.Applicative ((<$>))+import Control.Monad.Trans (MonadIO,liftIO)+import Data.Char (isSpace)+import Data.Monoid (mconcat)+import qualified Network.Curl as C+import Network.URI (escapeURIString)+import Text.HTML.TagSoup (Tag(..),parseTags)++-- | A URL.+type URL = String++-- | Code to be pasted.+type Code = String++-- | A CodePad paste id e.g. HZPquoIO.+type PasteId = String++-- | Paste output+type PasteOutput = String++-- | Alias for supported CodePad languages.+type LangName = String++-- | CodePad's domain.+codepadUrl :: URL+codepadUrl = "http://codepad.org/"++-- | A CodePad URL of a page containing a list of supported languages.+codepadLangsURL :: URL+codepadLangsURL = "http://hpaste.codepad.org/"++-- | Make a CodePad URL for the given paste id.+pasteURL :: PasteId -- ^ ID of the CodePad paste to construct a URL for. + -> URL -- ^ A CodePad URL to the paste.+pasteURL pid = codepadUrl ++ pid++-- | Paste some code and get the run output too.+pasteAndRun :: MonadIO m+ => Code -- ^ Code to paste. + -> LangName -- ^ Language of the code. + -> Bool -- ^ Private? + -> m (Maybe (PasteId,PasteOutput)) -- ^ The paste id and the run output.+pasteAndRun code lang private = do+ result <- pasteCode code lang True private+ case result of+ Nothing -> return Nothing+ Just pid -> do+ out <- pasteOutput pid+ case out of+ Nothing -> return Nothing+ Just output -> return $ Just (pid,output)++-- | Perform a paste.+pasteCode :: MonadIO m+ => Code -- ^ Code to paste. + -> LangName -- ^ Language of the code. + -> Bool -- ^ Run it?+ -> Bool -- ^ Private?+ -> m (Maybe PasteId) -- ^ The pasted id.+pasteCode code lang run private = do+ r <- liftIO $ C.withCurlDo $ getResponse codepadUrl [C.CurlPostFields assocs] + if C.respStatus r == 302+ then return $ getId <$> lookup "Location" (C.respHeaders r)+ else return Nothing+ where getResponse :: C.URLString -> [C.CurlOption]+ -> IO (C.CurlResponse_ [(String,String)] String)+ getResponse = C.curlGetResponse_+ getId = reverse . takeWhile (/='/') . reverse+ assocs = ["code=" ++ encode code+ ,"lang=" ++ encode lang+ ,"run=" ++ show run+ ,"private=" ++ show private+ ,"submit=Submit"]+ encode = escapeURIString (const False)++-- | Get the run output for a paste id.+pasteOutput :: MonadIO m+ => PasteId -- ^ A CodePad paste id.+ -> m (Maybe PasteOutput) -- ^ Maybe the run output of that paste.+pasteOutput pid = do+ (code,t) <- liftIO $ C.withCurlDo $ C.curlGetString_ (pasteURL pid) []+ case code of+ C.CurlOK -> return $ parseOutput t+ _ -> return Nothing++-- | Get the list of supported languages.+supportedLangs :: MonadIO m => m (Maybe [LangName])+supportedLangs = do+ (code,t) <- liftIO $ C.withCurlDo $ C.curlGetString_ codepadLangsURL []+ case code of+ C.CurlOK -> return $ Just $ parseLangs t+ _ -> return Nothing ++-- | Get the paste output.+parseOutput :: String -- ^ Parse a paste page for the output.+ -> Maybe PasteOutput -- ^ Maybe the paste output.+parseOutput = toHeading . parseTags where+ toHeading (TagOpen "span" [("class","heading")]+ :TagText "Output:":xs) = skipLines xs+ toHeading (_:xs) = toHeading xs+ toHeading [] = Nothing+ skipLines (TagClose "pre":xs) = toPre xs+ skipLines (_:xs) = skipLines xs+ skipLines [] = Nothing+ toPre (TagOpen "pre" _:xs) = cleanUp <$> mconcat (collect xs)+ toPre (_:xs) = toPre xs+ toPre [] = Nothing+ collect (TagText t:xs) = Just t : collect xs+ collect (TagClose "pre":_) = []+ collect (_:xs) = collect xs+ collect [] = []+ -- Codepad adds extra space at the start and end of the pre.+ cleanUp s = dropWhile isSpace $ take (length s-1) s++-- | Extract the available languages from the CodePad page.+parseLangs :: String -- ^ The HTML page. + -> [LangName] -- ^ Any parsed language names.+parseLangs = toSelect . parseTags where + toSelect (TagOpen "select" ((_,"lang"):_):xs) = options xs+ toSelect (_:xs) = toSelect xs+ toSelect [] = []+ options (TagOpen "option" _:TagText lang:xs) = lang : options xs+ options (_:xs) = options xs+ options [] = []
+ codepad.cabal view
@@ -0,0 +1,22 @@+Name: codepad+Version: 0.1+Synopsis: Submit and retrieve paste output from CodePad.org.+Description: Submit and retrieve paste output from http://codepad.org/+Homepage: http://github.com/chrisdone/codepad+License: BSD3+License-file: LICENSE+Author: Chris Done+Maintainer: Chris Done <chrisdone@gmail.com>+Copyright: 2010 Chris Done+Category: Web+Build-type: Simple+Cabal-version: >=1.6++Library+ Exposed-modules: Web.Codepad+ Build-depends: base >= 4 && < 5,+ tagsoup == 0.10.*,+ network == 2.2.*,+ curl == 1.3.*,+ mtl == 1.1.*+