-- |-- Module : StreamEd-- Copyright : (c) Vitaliy Rukavishnikov-- License : BSD-style (see the file LICENSE)-- -- Maintainer : virukav@gmail.com-- Stability : experimental-- Portability : non-portable---- The Sed runtime enginemoduleHsed.StreamEdwhereimportSystem.IOimportControl.Monad(unless,when,forM_,zipWithM)importqualifiedControl.Monad.StateasSimportControl.Monad.Trans.GotoimportData.List(isPrefixOf)importData.Char(isPrint)importData.Maybe(fromMaybe)importqualifiedData.ByteString.Char8asBimportText.Printf(printf)importHsed.Parsec(parseSed,sedCmds)importHsed.AstimportHsed.SedRegeximportHsed.SedStatetypeSedEnginea=GotoTa(S.StateTEnvIO)adataStatus=EOF|Contderiving(Eq,Show)dataFlowControl=Next-- ^ Apply the next sed command from the script to the pattern space|Break-- ^ Read the new line to the pattern space and apply sed script |Continue-- ^ Reapply the sed script to the current pattern space|Goto(MaybeB.ByteString)-- ^ Jump to the marked sed command and apply it to the pattern space |Exit-- ^ Quit deriving(Eq,Show)-- | Compile and execute the sed scriptrunSed::[FilePath]->String->Env->IOEnvrunSedfssedenv=doS.execStateT(runGotoT$dowhen("#n"`isPrefixOf`sed)$S.lift$setdefOutputFalseS.lift$compilesedexecutefs)env-- | Parse the Sed commandscompile::String->SedState()compilecmds=docaseparseSedsedCmdscmdsofRightx->setastxLefte->error$showe++" in "++cmdsreturn()-- | Execute the parsed Sed commands against input dataexecute::[FilePath]->SedEngine()executefs=doprocessFilesfsfout<-S.lift$getfileoutS.liftIO$S.mapM_hClose(mapsndfout)-- | Process the input text filesprocessFiles::[FilePath]->SedEngine()processFilesfiles=doifnullfilesthenprocessFilestdinTrueelsedoletlen=lengthfilesletfs=zipWith(\xy->(x,y==len))files[1..len]S.forM_fs$\(file,lastFile)->doh<-S.liftIO$openFilefileReadModeprocessFilehlastFilewhereprocessFilehlastFile=doS.lift$setcurFile(h,lastFile)nextLine-- | Process the next input line from the filenextLine::SedEngine()nextLine=do(res,str)<-S.liftlinecaseresofEOF->return()Cont->doS.lift$setpatternSpacestrS.lift$setappendSpace[]cs<-S.lift$getastexecCmdscsnextLine-- | Execute sed scriptexecCmds::[SedCmd]->SedEngine()execCmdscs=doforM_cs$\cmd->dosch<-S.lift$execCmdcmdcaseschofNext->return()Break->gotonextLineContinue->goto(execCmdscs>>nextLine)Gotolbl->(S.lift$getast)>>=\a->goto(execCmds(jumpalbl)>>nextLine)Exit->prnPat>>goto(return())prnPatwhereprnPat=S.lift$printPatSpace>>getappendSpace>>=\a->mapM_prnStra-- | Transfer control to the command marked with the labeljump::[SedCmd]->MaybeLabel->[SedCmd]jumpcmds=maybe[](gocmds)wherego[]_=[]go(SedCmd_fun:cs)str=casefunofGroupcs'->gocs'strLabelx->ifx==strthencselsegocsstr_->gocsstr-- | Read an input lineline::SedState(Status,B.ByteString)line=do(h,b)<-getcurFilep<-S.lift$hIsEOFhifpthenreturn(EOF,B.empty)elsedostr<-S.lift$B.hGetLinehmodifycurLine(+1)isLast<-ifh==stdinthenreturnFalseelseS.lift(hIsEOFh)>>=\eof->returneofifisLast&&bthengetcurLine>>=\l->setlastLinel>>return(Cont,str)elsereturn(Cont,str)-- | Execute the Sed function if the address is matchedexecCmd::SedCmd->SedStateFlowControlexecCmd(SedCmdafun)=dob<-matchAddressaifbthenrunCmdfunelsereturnNext-- | Check if the address interval is matched matchAddress::Address->SedStateBoolmatchAddress(Addressaddr1addr2invert)=case(addr1,addr2)of(Justx,Nothing)->matchAddrxx>>=\b->return$b/=invert(Justx,Justy)->matchAddrxy>>=\b->return$b/=invert_->return$notinvertwherematchAddr::Addr->Addr->SedStateBoolmatchAddra1a2=dolineNum<-getcurLinepatSpace<-getpatternSpacelastLineNum<-getlastLinecase(a1,a2)of(LineNumberx,LineNumbery)->matchRange(x==lineNum)(y==lineNum)(LineNumberx,Paty)->matchRange(x==lineNum)(matchREypatSpace)(LineNumberx,LastLine)->matchRange(x==lineNum)(lineNum==lastLineNum)(LastLine,_)->return$lineNum==lastLineNum(Patx,Paty)->matchRange(matchRExpatSpace)(matchREypatSpace)(Patx,LineNumbery)->matchRange(matchRExpatSpace)(y==lineNum)(Patx,LastLine)->matchRange(matchRExpatSpace)(lineNum==lastLineNum)matchRange::Bool->Bool->SedStateBoolmatchRangeb1b2=doletsetRange=setinRangerange<-getinRangeifnotrangethenifb1&&b2thenreturnTrueelseifb1thensetRangeTrue>>returnTrueelsereturnFalseelseifb2thensetRangeFalse>>returnTrueelsereturnTrue-- | Execute the Sed functionrunCmd::SedFun->SedStateFlowControlrunCmdcmd=casecmdofGroupcs->groupcsLineNum->lineNumAppendtxt->appendtxtBranchlbl->branchlblChangetxt->changetxtDeleteLine->deleteLineDeletePat->deletePatReplacePat->replacePatAppendPat->appendPatReplaceHold->replaceHoldAppendHold->appendHoldInserttxt->inserttxtList->listNextLine->nextAppendLinePat->appendLinePatPrintPat->printPatWriteUpPat->writeUpPatQuit->quitReadFilefile->readFfileSubstitutepatreplfs->substitutepatreplfsTestlbl->testlblWriteFilefile->writeFfileExchange->exchangeTransformt1t2->transformt1t2Labellbl->labellblComment->commentEmptyCmd->emptyCmd-- | '{cmd...}' Groups subcommands enclosed in {} (braces)group::[SedCmd]->SedStateFlowControlgroup[]=returnNextgroup(cmd:xs)=dosch<-execCmdcmdifsch==Nextthengroupxselsereturnsch-- | '=' Writes the current line number to standard output as a linelineNum::SedStateFlowControllineNum=getcurLine>>=(prnStrLn.B.pack.show)>>returnNext-- | 'a\\ntext' Places the text variable in output before reading -- the next input lineappend::B.ByteString->SedStateFlowControlappendtxt=modifyappendSpace(++[txt,B.pack"\n"])>>returnNext-- | 'b label' Transfer control to :label elsewhere in scriptbranch::MaybeLabel->SedStateFlowControlbranch=return.Goto-- | 'c\\ntext' Replace the lines with the text variablechange::B.ByteString->SedStateFlowControlchangetxt=dorange<-getinRangeunlessrange$prnStrLntxtreturnBreak-- | 'd' Delete line(s) from pattern spacedeleteLine::SedStateFlowControldeleteLine=setpatternSpaceB.empty>>returnBreak-- | 'D' Delete first part (up to embedded newline) of multiline pattern spacedeletePat::SedStateFlowControldeletePat=dop<-getpatternSpaceletp'=B.drop1$B.dropWhile(/='\n')psetpatternSpacep'returnContinue-- | 'g' Copy contents of hold space into the pattern spacereplacePat::SedStateFlowControlreplacePat=getholdSpace>>=\h->setpatternSpaceh>>returnNext-- | 'G' Append newline followed by contents of hold space -- to contents of the pattern space.appendPat::SedStateFlowControlappendPat=getholdSpace>>=\h->modifypatternSpace(`B.append`B.cons'\n'h)>>returnNext-- | 'h' Copy pattern space into hold spacereplaceHold::SedStateFlowControlreplaceHold=getpatternSpace>>=\p->setholdSpacep>>returnNext-- | 'H' Append newline and contents of pattern space to contents -- of the hold spaceappendHold::SedStateFlowControlappendHold=getpatternSpace>>=\p->modifyholdSpace(`B.append`B.cons'\n'p)>>returnNext-- | 'i\\ntext' Writes the text variable to standard output before -- reading the next line into the pattern space.insert::B.ByteString->SedStateFlowControlinserttxt=prnStrLntxt>>returnNext-- | 't label' Jump to line if successful substitutions have been madetest::MaybeLabel->SedStateFlowControltestlbl=getsubst>>=\s->ifsthenreturn$GotolblelsereturnNext-- | 's/pattern/replacement/[flags]' Substitute replacement for patternsubstitute::B.ByteString->B.ByteString->Flags->SedStateFlowControlsubstitutepatreplfs=dolet(gn,p,w)=getFlagsfspatSpace<-getpatternSpacelet(repl',b)=sedSubRegexpatpatSpacereplgnsetsubstbwhenb$dosetpatternSpacerepl'whenp$getpatternSpace>>=\ps->prnStrLnpsunless(nullw)$writeFw>>return()returnNextwheregetFlags::Flags->(Int,Bool,FilePath)getFlags(Flagsof)=(occurr,printPat,file)where(occurr,printPat)=caseoofNothing->(1,False)Just(OccurrencePrintxy)->(occx,y)Just(PrintOccurrencexy)->(occy,x)occx=casexofNothing->1JustReplaceAll->0Just(Replacen)->nfile=fromMaybe""f-- | 'n' Read next line of input into pattern space. next::SedStateFlowControlnext=doprintPatSpace(res,str)<-linesetpatternSpacestrifres==EOFthenreturnBreakelsereturnNext-- | 'l' List the contents of the pattern space, showing -- nonprinting characters as ASCII codeslist::SedStateFlowControllist=dopatSpace<-getpatternSpaceS.forM_(B.unpackpatSpace)$\ch->ifisPrintchthenprnCharchelsecaselookupchescofNothing->doprnChar'\\'prnPrintfchJustx->prnStr(B.packx)prnChar'\n'returnNextwhereesc=zip"\\\a\b\f\r\t\v"["\\\\","\\a","\\b","\\f","\\r","\\t","\\v"]-- | 'x' Exchange contents of the pattern space with the -- contents of the hold spaceexchange::SedStateFlowControlexchange=dohold<-getholdSpacepat<-getpatternSpacesetholdSpacepatsetpatternSpaceholdreturnNext-- | 'N' Append next input line to contents of pattern spaceappendLinePat::SedStateFlowControlappendLinePat=do(res,ln)<-lineifres==EOFthenreturnBreakelsedoletsuffix=B.append(B.pack"\n")lnmodifypatternSpace(`B.append`suffix)returnNext-- | 'p' Print the linesprintPat::SedStateFlowControlprintPat=getpatternSpace>>=\p->prnStrLnp>>returnNext-- | 'P' Print first part (up to embedded newline) of -- multiline pattern spacewriteUpPat::SedStateFlowControlwriteUpPat=getpatternSpace>>=(prnStrLn.B.takeWhile(/='\n'))>>returnNext-- | 'q' Quitquit::SedStateFlowControlquit=returnExit-- | 'y/abc/xyz' Transform each character by position in string abc -- to its equivalent in string xyztransform::B.ByteString->B.ByteString->SedStateFlowControltransformt1t2=dowhen(B.lengtht1/=B.lengtht2)$error"Transform strings are not the same length"patSpace<-getpatternSpacelettr=B.mapgopatSpacesetpatternSpacetrreturnNextwheregoch=fromMaybech(lookupch(B.zipt1t2))-- | 'w file' Append contents of pattern space to filewriteF::FilePath->SedStateFlowControlwriteFfile=dofout<-getfileoutpatSpace<-getpatternSpaceletprintFileouth=S.lift$B.hPutStrLnhpatSpacecaselookupfilefoutofNothing->doh<-S.lift$openFilefileWriteModemodifyfileout(++[(file,h)])printFileouthJusth->printFileouthreturnNext-- | 'r' Read contents of file and append after the contents of the -- pattern spacereadF::FilePath->SedStateFlowControlreadFfile=docont<-S.lift$B.readFilefile`catch`\_->returnB.emptymodifyappendSpace(++[cont])returnNext-- | Skip label, comment and empty commandlabel_=returnNextcomment=returnNextemptyCmd=returnNext-- | Print the pattern space to the standard outputprintPatSpace::SedState()printPatSpace=doout<-getdefOutputwhenout$getpatternSpace>>=\p->prnStrLnp-- | Check if the current line in the pattern space is the last lineisLastLine::SedStateBoolisLastLine=dol<-getlastLinecur<-getcurLinereturn$l==cur-- | Writes the string to the standard output or save the string in the memory bufferprnStr::B.ByteString->SedState()prnStrstr=douseMem<-getuseMemSpaceifuseMemthenmodifymemorySpace(`B.append`str)elseS.lift$B.putStrstr-- | The same as prnStr, but adds a newline characterprnStrLn::B.ByteString->SedState()prnStrLnstr=prnStr$B.snocstr'\n'-- | The same as prnStr, but for charprnChar::Char->SedState()prnCharc=prnStr$B.singletonc-- | Print the character as three-digit octal numberprnPrintf::Char->SedState()prnPrintfc=doletstr=printf"%03o"c::StringprnStr$B.packstr