module Tools.TimePlot.Source ( readSource ) where import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as B import Data.ByteString.Lex.Fractional import Tools.TimePlot.Types readSource :: (Show t) => (S.ByteString -> Maybe (t, S.ByteString)) -> FilePath -> IO (ParseResult t) readSource readTime f = (toParseResult . map (parseLine . B.toStrict) . filter (not . B.null) . blines) `fmap` (if f == "-" then B.getContents else B.readFile f) where blines = map pruneLF . B.split '\n' pruneLF b | not (B.null b) && (B.last b == '\r') = B.init b | otherwise = b toParseResult [] = ParseResult [] [] toParseResult (Left e:es) = let ~(ParseResult pd up) = toParseResult es in ParseResult (e:pd) up toParseResult (Right s:es) = let ~(ParseResult pd up) = toParseResult es in ParseResult pd (s:up) parseLine s = (\x -> case x of { Just e -> Left e; Nothing -> Right s }) $ do (t, s') <- readTime s (_, s'') <- S.uncons s' (c,rest) <- S.uncons s'' case c of '>' -> return (t, InEdge rest Rise ) '<' -> return (t, InEdge rest Fall ) '!' -> do let (track, val') = S.break (==' ') rest let label = S.unpack $ S.drop 1 val' return (t, InEdge track (Pulse (Status "" label))) '@' -> do let (track, val') = S.break (==' ') rest (_,val) <- S.uncons val' return (t, InEdge track $ SetTo (Status {statusColor = S.unpack $ val, statusLabel = ""})) '=' -> do let (track, val') = S.break (==' ') rest (_,val) <- S.uncons val' case S.uncons val of Nothing -> Nothing Just (v, val') -> case v of '`' -> do return (t, InAtom track val') _ -> do (v, _) <- readSigned readDecimal val return (t, InValue track v) _ -> Nothing