module Data.LHE (
parseFile,
parse,
) where
import qualified Data.ByteString.Char8 as S
import Text.XML.HaXml.ParseLazy (xmlParse)
import Text.XML.HaXml.Types (Document(..), Element(..), Content(..), QName(..))
import Data.LHA
data RawRun = RawRun [String] [[String]]
deriving (Eq, Show)
data RawEvent = RawEvent [String] [[String]]
deriving (Eq, Show)
parseFile :: String -> IO (Run, [Event])
parseFile fname = S.readFile fname >>= return . parse fname
parse :: String -> S.ByteString -> (Run, [Event])
parse fname dat =
let doc = xmlParse fname $ S.unpack dat in
(runFromDoc doc, eventsFromDoc doc)
runFromDoc = makeRun . rawRunFromDoc
eventsFromDoc d =
let re = rawEventsFromDoc d in
map makeEvent re
makeRun :: RawRun -> Run
makeRun (RawRun (bpdg1:bpdg2:be1:be2:pdfg1:pdfg2:pdfs1:pdfs2:idwt:nproc:[]) ps) = Run
{ runBeam = ( Beam (read bpdg1) (parseDouble be1) (read pdfg1) (read pdfs1)
, Beam (read bpdg1) (parseDouble be1) (read pdfg1) (read pdfs1)
)
, idwt = read idwt
, nProc = read nproc
, procs = map makeProc ps
}
makeProc :: [String] -> Subprocess
makeProc (d1:d2:d3:i1:[]) = Subprocess
(parseDouble d1)
(parseDouble d2)
(parseDouble d3)
(read i1)
makeEvent :: RawEvent -> Event
makeEvent (RawEvent (n:idpr:xwgt:scal:aqed:aqcd:[]) rps) = Event
{ nPart = read n
, evProcId = read idpr
, evWeight = parseDouble xwgt
, scale = parseDouble scal
, aQED = parseDouble aqed
, aQCD = parseDouble aqcd
, parts = map makeParticle rps
}
makeParticle :: [String] -> Particle
makeParticle (pdg:stat:m1:m2:c1:c2:px:py:pz:e:m:lt:spin:[]) = Particle
{ partPDG = read pdg
, status = statusFromInt $ read stat
, mothers = PBoth (read m1, read m2)
, iColor = (read c1, read c2)
, partPx = parseDouble px
, partPy = parseDouble py
, partPz = parseDouble pz
, partE = parseDouble e
, partM = parseDouble m
, lifetime = parseDouble lt
, spin = parseDouble spin
}
parseRawEventFile :: String -> IO [RawEvent]
parseRawEventFile fname = S.readFile fname >>= return . parseRawEvents fname
parseRawEvents :: String -> S.ByteString -> [RawEvent]
parseRawEvents fname dat = rawEventsFromDoc $ xmlParse fname $ S.unpack dat
getElem (CElem (Elem _ _ c) _) = head $ filter isCString c
where isCString (CString _ _ _) = True
isCString _ = False
rawEventsFromDoc (Document _ _ (Elem eName _ eList) _) =
map (getRawEvent . getElem) $ filter isEvent eList
where
isEvent (CElem (Elem (N "event") _ _) _) = True
isEvent _ = False
parseLine = words
getRawEvent (CString _ eStr _) =
let eLines = filter (\x -> length x > 2) $ lines eStr in
RawEvent (parseLine $ head eLines) (map parseLine $ tail eLines)
getRawEvent _ = RawEvent [] []
rawRunFromDoc (Document _ _ (Elem eName _ eList) _) =
getRawRun $ getElem $ head $ filter isInit eList
where
isInit (CElem (Elem (N "init") _ _) _) = True
isInit _ = False
getRawRun (CString _ rStr _) =
let rLines = filter (\x -> length x > 2) $ lines rStr in
RawRun (words $ head rLines) (map words $ tail rLines)
getRawRun _ = RawRun [] []
parseDouble :: String -> Double
parseDouble = read . reverse . dropWhile (=='.') . reverse