moduleText.HTML.Tagchup.Tag(T(..),Name(..),mapName,open,isOpen,maybeOpen,close,isClose,maybeClose,text,isText,maybeText,innerText,comment,isComment,maybeComment,special,isSpecial,maybeSpecial,cdata,isCData,maybeCData,processing,isProcessing,maybeProcessing,warning,isWarning,maybeWarning,formatOpen,formatClose,textFromCData,concatTexts,mapText,mapTextA,)whereimportqualifiedText.HTML.Tagchup.CharacterasChrimportqualifiedText.XML.Basic.ProcessingInstructionasPIimportqualifiedText.XML.Basic.AttributeasAttrimportqualifiedText.XML.Basic.NameasNameimportqualifiedText.XML.Basic.FormatasFmtimportText.XML.Basic.Tag(Name(Name),cdataName,)importData.Tuple.HT(mapFst,)importData.Maybe(mapMaybe,fromMaybe,)importData.Monoid(Monoid,mempty,mappend,mconcat,)importControl.Monad(guard,)importData.Foldable(Foldable(foldMap),)importData.Traversable(Traversable(sequenceA),traverse,)importControl.Applicative(Applicative,pure,liftA,)-- * type definitions{- |
An HTML element, a document is @[T]@.
There is no requirement for 'Open' and 'Close' to match.
The type parameter @string@ lets you choose between
@[Char]@ for interpreted HTML entity references and
@[HTMLChar.T]@ for uninterpreted HTML entities.
You will most oftenly want plain @Char@,
since @HTMLChar.T@ is only necessary if you want to know,
whether a non-ASCII character was encoded as HTML entity
or as non-ASCII Unicode character.
-}dataTnamestring=Open(Namename)[Attr.Tnamestring]-- ^ An open tag with 'Attr.T's in their original order.|Close(Namename)-- ^ A closing tag|Textstring-- ^ A text node, guaranteed not to be the empty string|CommentString-- ^ A comment|Special(Namename)String-- ^ A tag like @\<!DOCTYPE ...\>@|Processing(Namename)(PI.Tnamestring)-- ^ A tag like @\<?xml ...\>@|WarningString-- ^ Mark a syntax error in the input filederiving(Show,Eq,Ord)instanceFunctor(Tname)wherefmapftag=casetagofOpennameattrs->Openname$map(fmapf)attrsClosename->ClosenameTextstring->Text$fstringCommentstring->CommentstringSpecialnamecontent->SpecialnamecontentProcessingnameproc->Processingname$fmapfprocWarningstring->WarningstringinstanceFoldable(Tname)wherefoldMapftag=casetagofOpen_nameattrs->foldMap(foldMapf)attrsClose_name->memptyTextstring->fstringComment_text->memptySpecial_name_content->memptyProcessing_nameproc->foldMapfprocWarning_text->memptyinstanceTraversable(Tname)wheresequenceAtag=casetagofOpennameattrs->liftA(Openname)$traversesequenceAattrsClosename->pure$ClosenameTextstring->liftAText$stringCommentstring->pure$CommentstringSpecialnamecontent->pure$SpecialnamecontentProcessingnameproc->liftA(Processingname)$sequenceAprocWarningstring->pure$WarningstringmapName::(Namename0->Namename1)->(Attr.Namename0->Attr.Namename1)->Tname0string->Tname1stringmapNamefgtag=casetagofOpennameattrs->Open(fname)$map(Attr.mapNameg)attrsClosename->Close(fname)Textstring->TextstringCommentstring->CommentstringSpecialnamecontent->Special(fname)contentProcessingnameproc->Processing(fname)$PI.mapNamegprocWarningstring->Warningstringinstance(Name.Tagname,Name.Attributename,Fmt.Cstring)=>Fmt.C(Tnamestring)whererunt=casetofOpennameattrs->formatOpenFalsenameattrsClosename->formatClosenameTextstr->Fmt.runstrCommentc->showString"<!--".showStringc.showString"-->"Warninge->showString"<!-- Warning: ".showStringe.showString" -->"Specialnamestr->Fmt.angle$Fmt.exclam.Fmt.namename.ifcdataName==namethenshowStringstr.showString"]]"elseFmt.blank.showStringstrProcessingnamep->Fmt.angle$Fmt.quest.Fmt.namename.Fmt.runp.Fmt.questformatOpen::(Name.Tagname,Name.Attributename,Fmt.Cstring)=>Bool->Namename->[Attr.Tnamestring]->ShowSformatOpenselfClosingnameattrs=Fmt.angle$Fmt.namename.Attr.formatListBlankHeadattrs.ifselfClosingthenFmt.slashelseidformatClose::(Name.Tagname)=>Namename->ShowSformatClosename=Fmt.angle$Fmt.slash.Fmt.namename-- * constructors for the tag typesopen::Namename->[Attr.Tnamestring]->Tnamestringopen=Openclose::Namename->Tnamestringclose=Closetext::string->Tnamestringtext=Textcomment::String->Tnamestringcomment=Commentspecial::Namename->String->Tnamestringspecial=Specialcdata::(Name.Tagname)=>String->Tnamestringcdata=specialcdataNameprocessing::Namename->PI.Tnamestring->Tnamestringprocessing=Processingwarning::String->Tnamestringwarning=Warning-- * check for the tag types-- | Test if a 'T' is a 'Open'isOpen::Tnamestring->BoolisOpentag=casetagof(Open{})->True;_->FalsemaybeOpen::Tnamestring->Maybe(Namename,[Attr.Tnamestring])maybeOpentag=casetagofOpennameattrs->Just(name,attrs);_->Nothing-- | Test if a 'T' is a 'Close'isClose::Tnamestring->BoolisClosetag=casetagof(Close{})->True;_->FalsemaybeClose::Tnamestring->Maybe(Namename)maybeClosetag=casetagofClosex->Justx;_->Nothing-- | Test if a 'T' is a 'Text'isText::Tnamestring->BoolisTexttag=casetagof(Text{})->True;_->False-- | Extract the string from within 'Text', otherwise 'Nothing'maybeText::Tnamestring->MaybestringmaybeTexttag=casetagofTextx->Justx;_->Nothing-- maybeText tag = do Text x <- Just tag; return x-- | Extract all text content from tags (similar to Verbatim found in HaXml)innerText::(Monoidstring)=>[Tnamestring]->stringinnerText=mconcat.mapMaybemaybeTextisComment::Tnamestring->BoolisCommenttag=casetagof(Comment{})->True;_->FalsemaybeComment::Tnamestring->MaybeStringmaybeCommenttag=casetagofCommentx->Justx;_->NothingisSpecial::Tnamestring->BoolisSpecialtag=casetagof(Special{})->True;_->FalsemaybeSpecial::Tnamestring->Maybe(Namename,String)maybeSpecialtag=casetagofSpecialnamecontent->Just(name,content);_->NothingisCData::(Name.Tagname)=>Tnamestring->BoolisCDatatag=casetagof(Specialname_)->cdataName==name;_->FalsemaybeCData::(Name.Tagname)=>Tnamestring->MaybeStringmaybeCDatatag=do(name,content)<-maybeSpecialtagguard(cdataName==name)returncontentisProcessing::Tnamestring->BoolisProcessingtag=casetagof(Processing{})->True;_->FalsemaybeProcessing::Tnamestring->Maybe(Namename,PI.Tnamestring)maybeProcessingtag=casetagofProcessingtargetinstr->Just(target,instr);_->NothingisWarning::Tnamestring->BoolisWarningtag=casetagof(Warning{})->True;_->FalsemaybeWarning::Tnamestring->MaybeStringmaybeWarningtag=casetagofWarningx->Justx;_->Nothing-- maybeWarning tag = do Warning x <- Just tag; return x-- * tag processing{- |
Replace CDATA sections by plain text.
-}textFromCData::(Name.Tagname,Chr.Cchar)=>Tname[char]->Tname[char]textFromCDatat=fromMaybet$do(name,content)<-maybeSpecialtguard(cdataName==name)return$Text$mapChr.fromCharcontent{-
textFromCData ::
(Name.Tag name) =>
T name String -> T name String
textFromCData t =
fromMaybe t $
do (name, content) <- maybeSpecial t
guard (cdataName == name)
return $ Text content
-}{-
case t of
Special name text ->
if cdataName == name
then Text text
else t
_ -> t
-}{- |
Merge adjacent Text sections.
-}concatTexts::Monoidstring=>[Tnamestring]->[Tnamestring]concatTexts=foldr(\tts->casetofTextstr0->uncurry(:)$mapFst(Text.mappendstr0)$casetsofTextstr1:rest->(str1,rest)_->(mempty,ts)_->t:ts)[]{- |
Modify content of a Text or a CDATA part.
-}mapText::(Name.Tagname)=>(String->String)->TnameString->TnameStringmapTextft=casetofTexts->Text$fsSpecialnames->Specialname$ifcdataName==namethenfselses_->tmapTextA::(Name.Tagname,Applicativef)=>(String->fString)->TnameString->f(TnameString)mapTextAft=casetofTexts->liftAText$fsSpecialnames->liftA(Specialname)$ifcdataName==namethenfselsepures_->puret