/usr/lib/hugs/packages/HaXml/programs/Xtract/Main.hs is in libhugs-haxml-bundled 98.200609.21-5.4+b3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | ------------------------------------------------------------
-- The Xtract tool - an XML-grep.
------------------------------------------------------------
module Main where
import System (getArgs, exitWith, ExitCode(..))
import IO
import Char (toLower)
import List (isSuffixOf)
import Text.XML.HaXml.Types
import Text.XML.HaXml.Posn (posInNewCxt)
import Text.XML.HaXml.Parse (xmlParse)
import Text.XML.HaXml.Html.Parse (htmlParse)
import Text.XML.HaXml.Xtract.Parse (xtract)
import Text.PrettyPrint.HughesPJ (render, vcat, hcat, empty)
import Text.XML.HaXml.Pretty (content)
import Text.XML.HaXml.Html.Generate (htmlprint)
main =
getArgs >>= \args->
if length args < 1 then
putStrLn "Usage: Xtract <pattern> [xmlfile ...]" >>
exitWith (ExitFailure 1)
else
let (pattern:files) = args
-- findcontents =
-- if null files then (getContents >>= \x-> return [xmlParse "<stdin>"x])
-- else mapM (\x-> do c <- (if x=="-" then getContents else readFile x)
-- return ((if isHTML x
-- then htmlParse x else xmlParse x) c))
-- files
in
-- findcontents >>= \cs->
-- ( hPutStrLn stdout . render . vcat
-- . map (vcat . map content . selection . getElem)) cs
mapM_ (\x-> do c <- (if x=="-" then getContents else readFile x)
( if isHTML x then
hPutStrLn stdout . render . htmlprint .
xtract (map toLower pattern) . getElem x . htmlParse x
else hPutStrLn stdout . render . format .
xtract pattern . getElem x . xmlParse x) c
hFlush stdout)
files
getElem x (Document _ _ e _) = CElem e (posInNewCxt x Nothing)
isHTML x = ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x
format [] = empty
format cs@(CString _ _ _:_) = hcat . map content $ cs
format cs@(CRef _ _:_) = hcat . map content $ cs
format cs = vcat . map content $ cs
|