-- | Simple pasting API for CodePad.org.moduleWeb.CodepadwhereimportControl.Applicative((<$>))importControl.Monad.Trans(MonadIO,liftIO)importData.Char(isSpace)importData.Monoid(mconcat)importqualifiedNetwork.CurlasCimportNetwork.URI(escapeURIString)importText.HTML.TagSoup(Tag(..),parseTags)-- | A URL.typeURL=String-- | Code to be pasted.typeCode=String-- | A CodePad paste id e.g. HZPquoIO.typePasteId=String-- | Paste outputtypePasteOutput=String-- | Alias for supported CodePad languages.typeLangName=String-- | CodePad's domain.codepadUrl::URLcodepadUrl="http://codepad.org/"-- | A CodePad URL of a page containing a list of supported languages.codepadLangsURL::URLcodepadLangsURL="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.pasteURLpid=codepadUrl++pid-- | Paste some code and get the run output too.pasteAndRun::MonadIOm=>Code-- ^ Code to paste. ->LangName-- ^ Language of the code. ->Bool-- ^ Private? ->m(Maybe(PasteId,PasteOutput))-- ^ The paste id and the run output.pasteAndRuncodelangprivate=doresult<-pasteCodecodelangTrueprivatecaseresultofNothing->returnNothingJustpid->doout<-pasteOutputpidcaseoutofNothing->returnNothingJustoutput->return$Just(pid,output)-- | Perform a paste.pasteCode::MonadIOm=>Code-- ^ Code to paste. ->LangName-- ^ Language of the code. ->Bool-- ^ Run it?->Bool-- ^ Private?->m(MaybePasteId)-- ^ The pasted id.pasteCodecodelangrunprivate=dor<-liftIO$C.withCurlDo$getResponsecodepadUrl[C.CurlPostFieldsassocs]ifC.respStatusr==302thenreturn$getId<$>lookup"Location"(C.respHeadersr)elsereturnNothingwheregetResponse::C.URLString->[C.CurlOption]->IO(C.CurlResponse_[(String,String)]String)getResponse=C.curlGetResponse_getId=reverse.takeWhile(/='/').reverseassocs=["code="++encodecode,"lang="++encodelang,"run="++showrun,"private="++showprivate,"submit=Submit"]encode=escapeURIString(constFalse)-- | Get the run output for a paste id.pasteOutput::MonadIOm=>PasteId-- ^ A CodePad paste id.->m(MaybePasteOutput)-- ^ Maybe the run output of that paste.pasteOutputpid=do(code,t)<-liftIO$C.withCurlDo$C.curlGetString_(pasteURLpid)[]casecodeofC.CurlOK->return$parseOutputt_->returnNothing-- | Get the list of supported languages.supportedLangs::MonadIOm=>m(Maybe[LangName])supportedLangs=do(code,t)<-liftIO$C.withCurlDo$C.curlGetString_codepadLangsURL[]casecodeofC.CurlOK->return$Just$parseLangst_->returnNothing-- | Get the paste output.parseOutput::String-- ^ Parse a paste page for the output.->MaybePasteOutput-- ^ Maybe the paste output.parseOutput=toHeading.parseTagswheretoHeading(TagOpen"span"[("class","heading")]:TagText"Output:":xs)=skipLinesxstoHeading(_:xs)=toHeadingxstoHeading[]=NothingskipLines(TagClose"pre":xs)=toPrexsskipLines(_:xs)=skipLinesxsskipLines[]=NothingtoPre(TagOpen"pre"_:xs)=cleanUp<$>mconcat(collectxs)toPre(_:xs)=toPrexstoPre[]=Nothingcollect(TagTextt:xs)=Justt:collectxscollect(TagClose"pre":_)=[]collect(_:xs)=collectxscollect[]=[]-- Codepad adds extra space at the start and end of the pre.cleanUps=dropWhileisSpace$take(lengths-1)s-- | Extract the available languages from the CodePad page.parseLangs::String-- ^ The HTML page. ->[LangName]-- ^ Any parsed language names.parseLangs=toSelect.parseTagswheretoSelect(TagOpen"select"((_,"lang"):_):xs)=optionsxstoSelect(_:xs)=toSelectxstoSelect[]=[]options(TagOpen"option"_:TagTextlang:xs)=lang:optionsxsoptions(_:xs)=optionsxsoptions[]=[]