Funktionale Programmierung: HTML Seiten erzeugen (2)

module Main
where
 
import Text.XML.HXT.Arrow
import System.Environment
 
main :: IO ()
main
    = do
      [src, dst] <- getArgs
      runX ( readDocument
               [ (a_parse_html, v_1)
               , (a_issue_warnings, v_0)
               ] src
             >>>
             processDocument
             >>>
             writeDocument
               [ (a_indent, v_1)
               ] dst
           )
      return ()
processDocument :: ArrowXml a => a XmlTree XmlTree
processDocument
    = root [] [getChildren
               >>>
               isElem
               >>>
               genPage
              ]
      >>>
      addXHtmlDoctypeTransitional
genPage :: ArrowXml a => a XmlTree XmlTree
genPage
    = eelem "html"
      += ( eelem "head"
           += ( eelem "title"
                += txt "Content of haskell.org"
              )
         )
      += ( eelem "body"
           += sattr "class" "haskell"
           += ( eelem "h1"
                += txt "Content of haskell.org"
              )
           += ( eelem "pre"
                += formatBodyText
              )
         )
formatBodyText  :: ArrowXml a => a XmlTree XmlTree
formatBodyText
    = xshow getBodyText
      >>>
      arr ( words
            >>>
            trimLines 8 
            >>>
            map unwords
            >>>
            unlines
          )
      >>>
      mkText
    where
    trimLines n [] = []
    trimLines n xs = take n xs :
                     trimLines n (drop n xs) 
getBodyText     :: ArrowXml a => a XmlTree XmlTree
getBodyText
    = hasName "html"
      />
      hasName "body"
      //>
      ( hasName "div"
        >>>
        hasAttrValue "id" (== "content")
      )
      //>
      ( hasName "td"
        >>>
        hasAttrValue "valign" (== "top")
        >>>
        hasAttrValue "width" (== "75%")
      )
      />
      deep isText
HTML Seiten erzeugen (2)

extractPureBodyText

Testlauf

2. Testlauf
