{-# LANGUAGE PatternGuards #-}------------------------------------------------------------------------------- |-- Module : Text.BlogLiterately.Ghci-- Copyright : (c) 1997-2005 Ralf Hinze <ralf.hinze@comlab.ox.ac.uk>, Andres Loeh <lhs2tex@andres-loeh.de>, 2012 Brent Yorgey-- License : GPL (see LICENSE)-- Maintainer : Brent Yorgey <byorgey@gmail.com>---- Format specially marked blocks as interactive ghci sessions. Uses-- some ugly but effective code for interacting with an external ghci-- process taken from lhs2TeX.-------------------------------------------------------------------------------moduleText.BlogLiterately.Ghci(-- * Running ghciProcessInfo,ghciEval,withGhciProcess,isLiterate,stopGhci-- * Extracting output-- $extract,magic,extract',extract,breaks-- * Formatting,formatInlineGhci)whereimportControl.Arrow(first)importControl.Monad.IO.Class(liftIO)importControl.Monad.Trans.Reader(ReaderT,runReaderT,ask)importData.Char(isSpace)importData.Functor((<$>))importData.List(isPrefixOf,intercalate)importSystem.IOimportSystem.Process(ProcessHandle,waitForProcess,runInteractiveCommand)importData.List.SplitimportText.Pandoc(Pandoc,Block(CodeBlock),bottomUpM)importText.BlogLiterately.Block(unTag)-- | Information about a running process: stdin, stdout, stderr, and a-- handle.typeProcessInfo=(Handle,Handle,Handle,ProcessHandle)-- | An input to ghci consists of an expression/command, possibly-- paired with an expected output.dataGhciInput=GhciInput{expr::String,expected::MaybeString}derivingShow-- | An output from ghci is either a correct output, or an incorrect-- (unexpected) output paired with the expected output.dataGhciOutput=OKString|UnexpectedStringStringderivingShow-- | A @GhciLine@ is a @GhciInput@ paired with its corresponding @GhciOutput@.dataGhciLine=GhciLineGhciInputGhciOutputderivingShow-- | Evaluate an expression using an external @ghci@ process.ghciEval::GhciInput->ReaderTProcessInfoIOGhciOutputghciEval(GhciInputexprexpected)=do(pin,pout,_,_)<-askletscript="putStrLn "++showmagic++"\n"++expr++"\n"++"putStrLn "++showmagic++"\n"out<-liftIO$dohPutStrpinscripthFlushpinextract'poutletout'=stripoutcaseexpectedofNothing->return$OKout'Justexp|out'==exp->return$OKout'|otherwise->return$Unexpectedout'exp-- | Start an external ghci process, run a computation with access to-- it, and finally stop the process.withGhciProcess::FilePath->ReaderTProcessInfoIOa->IOawithGhciProcessfm=doisLit<-isLiteratefpi<-runInteractiveCommand$"ghci -v0 -ignore-dot-ghci "++(ifisLitthenfelse"")res<-runReaderTmpistopGhcipireturnres-- | Poor man's check to see whether we have a literate Haskell file.isLiterate::FilePath->IOBoolisLiteratef=(any("> "`isPrefixOf`).lines)<$>readFilef-- | Stop a ghci process by passing it @:q@ and waiting for it to exit.stopGhci::ProcessInfo->IO()stopGhci(pin,_,_,pid)=dohPutStrLnpin":q"hFlushpin_<-waitForProcesspid-- ignore exit codereturn()-- $extract-- To extract the answer from @ghci@'s output we use a simple technique-- which should work in most cases: we print the string @magic@ before-- and after the expression we are interested in. We assume that-- everything that appears before the first occurrence of @magic@ on the-- same line is the prompt, and everything between the first @magic@ and-- the second @magic@ plus prompt is the result we look for.-- | There is nothing magic about the magic string.magic::Stringmagic="!@#$^&*"extract'::Handle->IOStringextract'h=fmap(extract.unlines)(readMagic2)wherereadMagic::Int->IO[String]readMagic0=return[]readMagicn=dol<-hGetLinehletn'|(null.snd.breaks(isPrefixOfmagic))l=n|otherwise=n-1fmap(l:)(readMagicn')extract::String->Stringextracts=vwhere(t,u)=breaks(isPrefixOfmagic)s-- t contains everything up to magic, u starts with magic-- |u' = tail (dropWhile (/='\n') u)|pre=reverse.takeWhile(/='\n').reverse$tprelength=ifnullprethen0elselengthpre+1-- pre contains the prefix of magic on the same lineu'=drop(lengthmagic+prelength)u-- we drop the magic string, plus the newline, plus the prefix(v,_)=breaks(isPrefixOf(pre++magic))u'-- we look for the next occurrence of prefix plus magicbreaks::([a]->Bool)->[a]->([a],[a])breaksp[]=([],[])breakspas@(a:as')|pas=([],as)|otherwise=first(a:)$breakspas'-- | Given the path to the @.lhs@ source and its representation as a-- @Pandoc@ document, @formatInlineGhci@ finds any @[ghci]@ blocks-- in it, runs them through @ghci@, and formats the results as an-- interactive @ghci@ session.---- Lines beginning in the first column of the block are interpreted-- as inputs. Lines indented by one or more space are interpreted-- as /expected outputs/. Consecutive indented lines are-- interpreted as one multi-line expected output, with a number of-- spaces removed from the beginning of each line equal to the-- number of spaces at the start of the first indented line.---- If the output for a given input is the same as the expected-- output (or if no expected output is given), the result is typeset-- normally. If the actual and expected outputs differ, the actual-- output is typeset first in red, then the expected output in blue.formatInlineGhci::FilePath->Pandoc->IOPandocformatInlineGhcif=withGhciProcessf.bottomUpMformatInlineGhci'whereformatInlineGhci'::Block->ReaderTProcessInfoIOBlockformatInlineGhci'b@(CodeBlockattrs)|Just"ghci"<-tag=doresults<-zipWithGhciLineinputs<$>mapMghciEvalinputsreturn$CodeBlockattr(intercalate"\n"$mapformatGhciResultresults)|otherwise=returnbwhere(tag,src)=unTagsinputs=parseGhciInputssrcformatInlineGhci'b=returnbparseGhciInputs::String->[GhciInput]parseGhciInputs=mapmkGhciInput.split(dropInitBlank.dropFinalBlank.keepDelimsL$whenElt(not.(" "`isPrefixOf`))).linesmkGhciInput::[String]->GhciInputmkGhciInput[i]=GhciInputiNothingmkGhciInput(i:exp)=GhciInputi(Just.unlines'.unindent$exp)unlines'::[String]->Stringunlines'=intercalate"\n"strip::String->Stringstrip=f.fwheref=dropWhileisSpace.reverseunindent::[String]->[String]unindent(x:xs)=map(dropindentAmt)(x:xs)whereindentAmt=length.takeWhile(==' ')$xindent::Int->String->Stringindentn=unlines'.map(replicaten' '++).linescoloredcolortxt="<span style=\"color: "++color++";\">"++txt++"</span>"coloredBlockcolor=unlines'.map(coloredcolor).linesghciPrompt=colored"gray""ghci&gt; "formatGhciResult(GhciLine(GhciInputinput_)(OKoutput))|allisSpaceoutput=ghciPrompt++escinput|otherwise=ghciPrompt++escinput++"\n"++indent2(escoutput)++"\n"formatGhciResult(GhciLine(GhciInputinput_)(Unexpectedoutputexp))=ghciPrompt++escinput++"\n"++indent2(coloredBlock"red"(escoutput))++"\n"++indent2(coloredBlock"blue"(escexp))++"\n"-- XXX the styles above should be configurable...esc::String->Stringesc=concatMapescapeOnewhereescapeOne'<'="&lt;"escapeOne'>'="&gt;"escapeOnec=[c]