folgerhs 0.1.0.1 → 0.3.0.1

raw patch · 11 files changed

+443/−180 lines, 11 filesdep +arraydep +containersdep +glossdep ~basedep ~xmlnew-component:exe:folgerhsPVP ok

version bump matches the API change (PVP)

Dependencies added: array, containers, gloss, optparse-applicative

Dependency ranges changed: base, xml

API changes (from Hackage documentation)

Files

• README.md +38/−6
• app/Folgerhs/Animate.hs +142/−0
• app/Folgerhs/Main.hs +68/−0
• app/Folgerhs/Presence.hs +32/−0
• app/Folgerhs/Speakers.hs +26/−0
• app/Protagonism/Main.hs +0/−34
• app/Stage/Main.hs +0/−49
• folgerhs.cabal +22/−21
• src/Folgerhs/Parse.hs +59/−0
• src/Folgerhs/Stage.hs +56/−46
• src/Folgerhs/Utils.hs +0/−24

@@ -1,15 +1,47 @@ -Growing toolset to parse and handle the XML annotated version of Shakespeare's-literature the Folger Shakespeare Library offers.+This library parses the TEI-encoded Shakespeare plays published by the Folger+Shakespeare Library. It also demonstrates different use cases for stage data by+providing some example applications. -The individual plays can be downloaded [here][downloads]. The complete set of-XML annotated plays can be downloaded [here][download-all].+You can download individual plays [here][downloads] and the complete set+[here][download-all]. +[downloads]: http://www.folgerdigitaltexts.org/download/+[download-all]: http://www.folgerdigitaltexts.org/download/xml/FolgerDigitalTexts_XML_Complete.zip+ The toolset can be installed using cabal or stack:      cabal install folgerhs     stack install folgerhs +Once installed, it can be used as a library (documentation needs yet to be+written) or as an application. -[downloads]: http://www.folgerdigitaltexts.org/download/-[download-all]: http://www.folgerdigitaltexts.org/download/xml/FolgerDigitalTexts_XML_Complete.zip+## Stage animation++The current speaker is surrounded by a white border, arrows going up represent+characters leaving the stage, arrows going down represent characters entering+it. The animation can be stopped using the `space` bar, you can advance it by+using the `right` arrow and rewind it using the `left` one.++    $ folgerhs animate TN.xml++![Part of Twelfth Night](./video.gif)++## Per-line character presence++With characters as columns and lines as rows, a line-by-line breakdown of+speakers and characters on stage.++    $ folgerhs presence R2.xml --without-unnamed | head -n 2+    Act.Scene.Line,RichardII,Gaunt,HenryIV,Mowbray,DuchessOfGloucester,LordMarshal,Aumerle,Green,Bagot,Bushy,York,Queen,Ross,Willoughby,Northumberland,Hotspur,Berkeley,Salisbury,WelshCaptain,BishopOfCarlisle,Scroop,Gardener,Fitzwater,Surrey,AbbotOfWestminster,DuchessOfYork,Exton,Groom,Jailer+    1.1.1,Speaker,Present,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent,Absent++## Per-character speech ratio++    $ folgerhs speakers Rom.xml | head -n 5+    19.38%   Romeo+    14.03%   Juliet+    10.70%   Nurse+    7.49%    Benvolio+    7.37%    Mercutio

@@ -0,0 +1,142 @@+module Folgerhs.Animate (animation) where++import System.Exit++import Data.Function (on)+import Data.Maybe+import Data.Array+import Data.List+import Data.Maybe (fromMaybe)++import Graphics.Gloss as G+import Graphics.Gloss.Data.Vector+import Graphics.Gloss.Interface.IO.Game++import Folgerhs.Stage as S+import Folgerhs.Parse (parse)++type Palette = (Character -> Color)+data State = Paused | Resumed+    deriving (Eq, Show)+type Play =  (State, (Array Int StageEvent), Int, Palette)++takeA :: (Ix i, Eq e) => Int -> (Array i e) -> [e]+takeA i a = take i $ elems a++colors :: [Color]+colors = cycle [ red, green, blue, yellow, magenta, rose, violet, azure,+                 aquamarine, chartreuse, orange ]++selectColor :: [Character] -> Palette+selectColor chs ch = fromMaybe (greyN 0.5) $ lookup ch (zip chs colors)++newPlay :: Line -> [StageEvent] -> Play+newPlay l ses = ( Paused+                , (listArray (1, length ses) ses)+                , (fromMaybe 1 (elemIndex (Milestone l) ses))+                , (selectColor $ characters ses) +                )++boxW :: Float+boxW = 140++boxH :: Float+boxH = 40++speak :: Picture -> Picture+speak p = pictures [color (greyN 0.85) (rectangleSolid (boxW+10) (boxH+10)), p]++arrow :: Picture+arrow = color white $ pictures [ G.line [o, t1]+                               , G.line [o, t2]+                               , G.line [o, t3]+                               ]+                                   where o = (0, boxH/4)+                                         t1 = mulSV (boxH/(-4)) (0,1)+                                         a = mulSV (boxH/6) (0,1)+                                         t2 = rotateV (pi/4) a+                                         t3 = rotateV (-(pi/4)) a++above :: Picture -> Picture+above = translate 0 (boxH*3/4)++enter :: Picture -> Picture+enter p = pictures [p, color (withAlpha 0.6 black) (rectangleSolid boxW boxH), above (rotate 180 arrow)]++exit :: Picture -> Picture+exit p = pictures [p, color (withAlpha 0.6 black) (rectangleSolid boxW boxH), above arrow]++charPic :: Character -> Bool -> Color -> Picture+charPic ch sp c = let box = color c $ rectangleSolid boxW boxH+                      name = translate (-60) (-4) $ scale 0.1 0.1 $ text ch+                      pic = pictures [box, name]+                   in if sp then speak pic else pic++transArc :: Float -> Float -> Picture -> Picture+transArc d a p = let (x, y) = mulSV d $ unitVectorAtAngle a+                  in translate x y p++optPos :: Float -> Float -> Int -> (Float, Float)+optPos a s i = let i' = fromIntegral i+                in (max a (s*i' / (2*pi)), 2*pi / i')++charPics :: Play -> [Picture]+charPics p@(_,ses,i,cf) = let sp = accumSpeaker (takeA i ses)+                              chs = accumStage (takeA i ses)+                              charPic' ch = charPic ch (ch == sp) (cf ch)+                           in case ses ! i of+                                (Entrance chs') -> map charPic' (chs \\ chs') ++ map (enter . charPic') chs'+                                (Exit chs') -> map charPic' (chs \\ chs') ++ map (exit . charPic') chs'+                                _ -> map charPic' chs++curLine :: Play -> Line+curLine (_, ses, i, _) = let past = [ ses ! i' | i' <- [i, i-1 .. fst (bounds ses)] ]+                          in fromMaybe "0" $ listToMaybe $ mapMaybe maybeLine past++lineRatio :: Play -> Float+lineRatio p@(_, ses, _, _) = let ls = S.lines (elems ses)+                                 i = fromMaybe 0 $ elemIndex (curLine p) ls+                              in on (/) fromIntegral i (length ls)++clock :: Play -> Picture+clock p = let d = translate (-60) (-10) $ scale 0.3 0.3 $ color white $ text $ curLine p+              a = color (greyN 0.2) $ rotate (-90) $ scale 1 (-1) $ thickArc 0 (lineRatio p * 360) 75 5+           in pictures [d, a]+++playPic :: Play -> IO Picture+playPic p = let pics = charPics p+                (d, a) = optPos 200 175 (length pics)+                posPics = [ transArc d (i*a) pic | (i, pic) <- zip [0..] pics ]+             in return $ pictures $ clock p : posPics++playEvent :: Event -> Play -> IO Play+playEvent (EventKey (SpecialKey KeyEsc) Down _ _) _ = exitSuccess+playEvent (EventKey (SpecialKey KeySpace) Down _ _) (Paused, ses, i, cf) = return (Resumed, ses, i, cf)+playEvent (EventKey (SpecialKey KeySpace) Down _ _) (Resumed, ses, i, cf) = return (Paused, ses, i, cf)+playEvent (EventKey (SpecialKey KeyLeft) Down _ _) (p, ses, i, cf) = return (p, ses, max (fst $ bounds ses) (i-50), cf)+playEvent (EventKey (SpecialKey KeyRight) Down _ _) (p, ses, i, cf) = return (p, ses, min (snd $ bounds ses) (i+50), cf)+playEvent _ p = return p++playStep :: Float -> Play -> IO Play+playStep t (Resumed, ses, i, cf) = let n = (Resumed, ses, (i+1), cf)+                                    in case ses ! (i+1) of+                                         Speech _ -> playStep t n+                                         _ -> return n+playStep _ p = return p++replicateChanges :: Int -> [StageEvent] -> [StageEvent]+replicateChanges i [] = []+replicateChanges i (se:ses) = let r = replicateChanges i ses+                               in case se of+                                    Entrance _ -> replicate i se ++ r+                                    Exit _ -> replicate i se ++ r+                                    _ -> se : r++animation :: FilePath -> Int -> Bool -> Line -> IO ()+animation f lps wu sl = let dis = FullScreen+                            bg = greyN 0.05+                            scf = if wu then hasName else const True+                            np = newPlay sl . replicateChanges 10 . selectCharacters scf . parse+                         in do source <- readFile f+                               playIO dis bg lps (np source) playPic playEvent playStep

@@ -0,0 +1,68 @@+module Main (main) where++import Options.Applicative+import Data.Monoid ((<>))++import Folgerhs.Stage+import Folgerhs.Speakers (speakers)+import Folgerhs.Presence (presence)+import Folgerhs.Animate (animation)++data Config = Presence FilePath Bool+            | Speakers FilePath+            | Animate FilePath Int Bool Line++config :: Parser Config+config = hsubparser+       ( command "presence"+         ( info presenceConfig (progDesc "Line-by-line on stage presence as CSV") )+      <> command "animate"+         ( info animateConfig (progDesc "Animated character interaction") )+      <> command "speakers"+         ( info speakersConfig (progDesc "Speech ratio per character") )+       )++presenceConfig :: Parser Config+presenceConfig = Presence+       <$> strArgument+            ( metavar "FILENAME"+           <> help "File to parse" )+       <*> switch+            ( long "without-unnamed"+            <> help "Exclude unnamed characters")++speakersConfig :: Parser Config+speakersConfig = Speakers+       <$> strArgument+            ( metavar "FILENAME"+           <> help "File to parse" )++animateConfig :: Parser Config+animateConfig = Animate+       <$> strArgument+            ( metavar "FILENAME"+           <> help "File to parse" )+       <*> option auto+            ( long "rate"+            <> value 10+            <> metavar "RATE"+            <> help "Lines per second")+       <*> switch+            ( long "without-unnamed"+            <> help "Exclude unnamed characters")+       <*> strOption+            ( long "seek-line"+            <> value "0"+            <> metavar "ACT.SCENE.LINE"+            <> help "Start animation from given line")++execute :: Config -> IO ()+execute (Presence f wu) = presence f wu+execute (Speakers f) = speakers f+execute (Animate f lps wu sl) = animation f lps wu sl++main :: IO ()+main = execParser opts >>= execute+    where+        desc = "Example usage of the toolset for Folger Shakespeare Library's TEI-encoded plays"+        opts = info (helper <*> config) ( progDesc desc <> fullDesc )

@@ -0,0 +1,32 @@+module Folgerhs.Presence (presence) where++import Control.Monad+import Data.List+import Data.Bool++import Folgerhs.Stage as S+import Folgerhs.Parse (parse)++type Row = (Line, [String])++rows :: [Character] -> [StageEvent] -> [Row]+rows chs ses = [ (l, [ presence l ch | ch <- chs ]) | l <- S.lines ses ]+    where presence l ch = if lineSpeaker l ses == ch +                             then "Speaker"+                             else bool "Absent" "Present" $+                                 (elem ch $ lineStage l ses)++displayRow :: Row -> String+displayRow (l, ss) = l ++ "," ++ intercalate "," ss++displayHeader :: [Character] -> String+displayHeader chs = "Act.Scene.Line," ++ intercalate "," chs++presence :: FilePath -> Bool -> IO ()+presence f wu = do source <- readFile f+                   let scf = if wu then hasName else const True+                       ses = selectCharacters scf $ parse source+                       chs = characters ses+                   putStrLn $ displayHeader chs+                   mapM_ (putStrLn . displayRow) (rows chs ses)+                   return ()

@@ -0,0 +1,26 @@+module Folgerhs.Speakers (speakers) where++import Data.Function (on)+import Data.List+import Data.Maybe+import Data.Ord++import Text.Printf (printf)++import Folgerhs.Stage+import Folgerhs.Parse (parse)+++sortedPercent :: [Character] -> [(Character, Float)]+sortedPercent chs = let perCh = [ (head g, g % chs) | g <- group (sort chs) ]+                     in sortBy (flip $ comparing snd) perCh+                    where (%) a b = on (/) (fromIntegral . length) a b+                            +reprProt :: (Character, Float) -> String+reprProt (c, r) = printf "%.2f%% \t %s" (r*100) c++speakers :: FilePath -> IO ()+speakers f = do source <- readFile f+                let sps = mapMaybe maybeSpeaker (parse source)+                mapM_ (putStrLn . reprProt) (sortedPercent sps)+                return ()

@@ -1,34 +0,0 @@-module Main (main) where--import Control.Monad-import System.Environment-import Data.Function (on)-import Data.List--import Text.XML.Light.Input (parseXML)-import Text.Printf (printf)--import Folgerhs.Stage--speaker :: State -> String-speaker (_, s, _) = s--count :: Eq a => a -> [a] -> Int-count e = length . filter (e ==)--protagonism :: [String] -> [(String, Float)]-protagonism ss = sortBy (flip $ on compare snd) $ map (`charProt` ss) (nub ss)-    where charProt c ss = (c, fromIntegral (count c ss) / fromIntegral (length ss))--reprProt :: (String, Float) -> String-reprProt (c, r) = printf "%.2f%% \t %s" (r*100) c--main :: IO ()-main = do args <- getArgs-          if length args /= 1-             then error "Expecting filename."-             else do source <- readFile $ head args-                     let contents = parseXML source-                         speakers = map speaker $ states (corpus contents) beginning-                     mapM_ (putStrLn . reprProt) (protagonism speakers)-                     return ()

@@ -1,49 +0,0 @@-module Main (main) where--import Control.Monad-import System.Environment-import Data.List-import Data.Bool-import Data.Maybe--import Text.XML.Light.Input (parseXML)--import Folgerhs.Stage---displayState :: [Character] -> State -> String-displayState gcs (l, s, cs) = l ++ "," ++ s ++ "," ++ displayStageChar gcs cs-    where displayStageChar gcs cs = intercalate "," $ map (bool "0" "1" . (`elem` cs)) gcs--displayStage :: Character -> [Character] -> Character -> String-displayStage s cs c = if s == c-                         then "Speaker"-                         else bool "Absent" "Present" (elem c cs)--displayRow :: [Character] -> State -> String-displayRow gcs (l, s, cs) = l ++ "," ++ intercalate "," (map (displayStage s cs) gcs)--displayCharacter :: Character -> String-displayCharacter c = let n = fromMaybe c (stripPrefix "#" c)-                      in case span (/= '_') $ reverse n of-                           ("", p) -> p-                           (s, "") -> s-                           (s, p) -> reverse $ tail p--displayHeader :: [Character] -> String-displayHeader gcs = "Act.Scene.Line," ++ intercalate "," (map displayCharacter gcs)--characters :: [State] -> [Character]-characters = nub . concatMap (\(_, _, cs) -> cs)--main :: IO ()-main = do args <- getArgs-          if length args /= 1-             then error "Expecting filename."-             else do source <- readFile $ head args-                     let contents = parseXML source-                         results = states (corpus contents) beginning-                         gcs = characters results-                     putStrLn $ displayHeader gcs-                     mapM_ (putStrLn . displayRow gcs) results-                     return ()

@@ -1,13 +1,13 @@ name:                folgerhs-version:             0.1.0.1+version:             0.3.0.1 synopsis:            Toolset for Folger Shakespeare Library's XML annotated plays description:         Toolset for Folger Shakespeare Library's XML annotated plays-homepage:            https://github.com/SU-LOSP/tools#readme+homepage:            https://github.com/SU-LOSP/folgerhs#readme license:             GPL-3 license-file:        LICENSE-author:              Unai Zalakain-maintainer:          unai@gisa-elkartea.org-copyright:           2017 Unai Zalakain+author:              Uma Zalakain+maintainer:          uma@gisa-elkartea.org+copyright:           2017 Uma Zalakain category:            Text build-type:          Simple extra-source-files:  README.md@@ -15,29 +15,30 @@  library   hs-source-dirs:      src-  exposed-modules:     Folgerhs.Utils, Folgerhs.Stage+  exposed-modules:     Folgerhs.Parse, Folgerhs.Stage   build-depends:       base >= 4.7 && < 5-                     , xml >= 1.3.14 && < 1.3.15-  default-language:    Haskell2010--executable folger-stage-  hs-source-dirs:      app-  main-is:             Stage/Main.hs-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  build-depends:       base-                     , folgerhs-                     , xml >= 1.3.14 && < 1.3.15+                     , xml+                     , containers+                     , array+                     , gloss   default-language:    Haskell2010 -executable folger-protagonism+executable folgerhs   hs-source-dirs:      app-  main-is:             Protagonism/Main.hs+  main-is:             Folgerhs/Main.hs   ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  build-depends:       base+  other-modules:       Folgerhs.Animate+                     , Folgerhs.Presence+                     , Folgerhs.Speakers+  build-depends:       base >= 4.7 && < 5                      , folgerhs-                     , xml >= 1.3.14 && < 1.3.15+                     , xml+                     , containers+                     , array+                     , gloss+                     , optparse-applicative   default-language:    Haskell2010  source-repository head   type:     git-  location: https://github.com/SU-LOSP/tools+  location: https://github.com/SU-LOSP/folgerhs

@@ -0,0 +1,59 @@+module Folgerhs.Parse ( parseCorpus+                      , corpus+                      , parse+                      ) where++import Data.Maybe+import Data.List+import Text.XML.Light.Input (parseXML)+import Text.XML.Light.Proc (onlyElems, elChildren)+import Text.XML.Light.Types (QName (..), Element (..), Content, Attr (..) )++import Folgerhs.Stage++isTag :: String -> Element -> Bool+isTag n = (==) n . qName . elName++drillTagPath :: [String] -> [Element] -> [Element]+drillTagPath [] = id+drillTagPath (n:ns) = drillTagPath ns . concatMap elChildren . filter (isTag n)++attr :: String -> Element -> Maybe String+attr n = listToMaybe . map attrVal . filter ((==) n . qName . attrKey) . elAttribs++descendants :: Element -> [Element]+descendants e = e : concatMap descendants (elChildren e)++corpus :: [Content] -> [Element]+corpus = concatMap descendants . drillTagPath ["TEI", "text", "body"] . onlyElems++charName :: String -> Character+charName c = let n = fromMaybe c (stripPrefix "#" c)+              in case span (/= '_') $ reverse n of+                   ("", p) -> p+                   (s, "") -> s+                   (s, p) -> reverse $ tail p++parseElement :: Element -> Maybe StageEvent+parseElement el+  | isTag "milestone" el = case (attr "unit" el, attr "n" el) of+                             (Just "ftln", Just n) -> Just $ Milestone n +                             _ -> Nothing+  | isTag "sp" el = case attr "who" el of+                      Just s -> Just $ Speech (charName s)+                      _ -> Nothing+  | isTag "stage" el = case (attr "type" el, attr "who" el) of+                         (Just "entrance", Just cs) -> Just $ Entrance (map charName $ words cs)+                         (Just "exit", Just cs) -> Just $ Exit (map charName $ words cs)+                         _ -> Nothing+  | otherwise = Nothing++parseCorpus :: [Element] -> [StageEvent]+parseCorpus [] = []+parseCorpus (e:es) = case parseElement e of+                        Just se -> se : parseCorpus es+                        Nothing -> parseCorpus es++parse :: String -> [StageEvent]+parse input = let content = parseXML input+               in parseCorpus (corpus content)

@@ -1,60 +1,70 @@-module Folgerhs.Stage ( State-                      , Character-                      , Line-                      , corpus-                      , beginning-                      , states-                      ) where+module Folgerhs.Stage where +import Data.Maybe import Data.List-import Control.Monad+import Data.Char (isLower) -import Text.XML.Light.Proc (onlyElems)-import Text.XML.Light.Types (Content, Element)+type Line = String+type Character = String+data StageEvent = Milestone Line+                | Entrance [Character]+                | Exit [Character]+                | Speech Character+                deriving (Eq, Show) -import Folgerhs.Utils+onStage :: [Character] -> StageEvent -> [Character]+onStage chs (Entrance chs') = nub (chs ++ chs')+onStage chs (Exit chs') = chs \\ chs'+onStage chs _ = chs +speaker :: Character -> StageEvent -> Character+speaker _ (Speech ch') = ch'+speaker ch _ = ch -type Line = String-type Character = String-type State = (Line, Character, [Character])+maybeSpeaker :: StageEvent -> Maybe Character+maybeSpeaker (Speech ch) = Just ch+maybeSpeaker _ = Nothing -corpus :: [Content] -> [Element]-corpus = concatMap descendants . drillTagPath ["TEI", "text", "body"] . onlyElems+line :: Line -> StageEvent -> Line+line _ (Milestone l') = l'+line l _ = l -beginning :: State-beginning = ("0", "", [])+maybeLine :: StageEvent -> Maybe Line+maybeLine (Milestone l) = Just l+maybeLine _ = Nothing -setLine :: Line -> State -> State-setLine n' (n, s, cs) = (n', s, cs)+lines :: [StageEvent] -> [Line]+lines = mapMaybe maybeLine -setSpeaker :: Character -> State -> State-setSpeaker s' (n, s, cs) = (n, s', cs)+isLine :: Line -> StageEvent -> Bool+isLine l = maybe False ((==) l) . maybeLine -stageEntrance :: String -> State -> State-stageEntrance crepr' (n, s, cs) = let cs' = words crepr'-                                   in (n, s, nub (cs' ++ cs))+accumStage :: [StageEvent] -> [Character]+accumStage = foldl onStage [] -stageExit :: String -> State -> State-stageExit crepr' (n, s, cs) = let cs' = words crepr'-                               in (n, s, cs \\ cs')+lineStage :: Line -> [StageEvent] -> [Character]+lineStage l = accumStage . takeWhile (not . isLine l) -state :: Element -> State -> Maybe State-state el st-  | isTag "milestone" el = case (attr "unit" el, attr "n" el) of-                             (Just "ftln", Just n) -> return $ setLine n st-                             _ -> Nothing-  | isTag "sp" el = case attr "who" el of-                      Just s -> return $ setSpeaker s st-                      _ -> Nothing-  | isTag "stage" el = case (attr "type" el, attr "who" el) of-                         (Just "entrance", Just cs) -> return $ stageEntrance cs st-                         (Just "exit", Just cs) -> return $ stageExit cs st-                         _ -> Nothing-  | otherwise = Nothing+accumSpeaker :: [StageEvent] -> Character+accumSpeaker = foldl speaker "" -states :: [Element] -> State -> [State]-states [] st = [st]-states (e:es) st = case state e st of-                     Just st' -> st : states es st'-                     Nothing -> states es st+lineSpeaker :: Line -> [StageEvent] -> Character+lineSpeaker l = accumSpeaker . takeWhile (not . isLine l)++characters :: [StageEvent] -> [Character]+characters [] = []+characters (se:ses) = case se of+                        Entrance chs -> nub $ chs ++ characters ses+                        _ -> characters ses++hasName :: Character -> Bool+hasName = any isLower . takeWhile (/= '.')++selectCharacters :: (Character -> Bool) -> [StageEvent] -> [StageEvent]+selectCharacters _ [] = []+selectCharacters f (se:ses) = let r = selectCharacters f ses+                               in case se of+                                Entrance chs -> Entrance (filter f chs) : r+                                Exit chs -> Exit (filter f chs) : r+                                Speech ch -> if f ch then se : r else r+                                se -> se : r

@@ -1,24 +0,0 @@-module Folgerhs.Utils ( isTag-                    , drillTagPath-                    , attr-                    , descendants-                    ) where--import Data.Maybe--import Text.XML.Light.Proc (elChildren)-import Text.XML.Light.Types (QName (..), Element (..), Content, Attr (..) )---isTag :: String -> Element -> Bool-isTag n = (==) n . qName . elName--drillTagPath :: [String] -> [Element] -> [Element]-drillTagPath [] = id-drillTagPath (n:ns) = drillTagPath ns . concatMap elChildren . filter (isTag n)--attr :: String -> Element -> Maybe String-attr n = listToMaybe . map attrVal . filter ((==) n . qName . attrKey) . elAttribs--descendants :: Element -> [Element]-descendants e = e : concatMap descendants (elChildren e)