{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Trace.Hpc.Codecov.Parser
( readTix'
, readMix'
) where
import Control.Applicative (Alternative (..))
import Data.Functor (($>))
import Prelude hiding (takeWhile)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import System.FilePath ((<.>), (</>))
import Trace.Hpc.Mix (BoxLabel (..), CondBox (..),
Mix (..), MixEntry)
import Trace.Hpc.Tix (Tix (..), TixModule (..),
tixModuleName)
import Trace.Hpc.Util (HpcHash (..), HpcPos, catchIO,
toHpcPos)
import Data.Time.Clock (UTCTime (..))
import Data.Time.Format (defaultTimeLocale, parseTimeM)
readTix' :: FilePath -> IO (Maybe Tix)
readTix' :: FilePath -> IO (Maybe Tix)
readTix' FilePath
path =
(P Tix -> ByteString -> Maybe Tix
forall a. P a -> ByteString -> Maybe a
runMaybeP P Tix
parseTix (ByteString -> Maybe Tix) -> IO ByteString -> IO (Maybe Tix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
path) IO (Maybe Tix) -> (IOException -> IO (Maybe Tix)) -> IO (Maybe Tix)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IO (Maybe Tix) -> IOException -> IO (Maybe Tix)
forall a b. a -> b -> a
const (Maybe Tix -> IO (Maybe Tix)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Tix
forall a. Maybe a
Nothing)
readMix'
:: [String]
-> Either String TixModule
-> IO Mix
readMix' :: [FilePath] -> Either FilePath TixModule -> IO Mix
readMix' [FilePath]
dirs Either FilePath TixModule
et_tm = [FilePath] -> IO Mix
go [FilePath]
dirs
where
mixname :: FilePath
mixname = (FilePath -> FilePath)
-> (TixModule -> FilePath) -> Either FilePath TixModule -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id TixModule -> FilePath
tixModuleName Either FilePath TixModule
et_tm FilePath -> FilePath -> FilePath
<.> FilePath
"mix"
handler :: p -> f (Either a b)
handler p
_ = Either a b -> f (Either a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b
forall a b. a -> Either a b
Left a
"err ...")
parse :: FilePath -> IO (Either FilePath Mix)
parse FilePath
path = P Mix -> ByteString -> Either FilePath Mix
forall a. P a -> ByteString -> Either FilePath a
runEitherP P Mix
parseMix (ByteString -> Either FilePath Mix)
-> IO ByteString -> IO (Either FilePath Mix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
path
go :: [FilePath] -> IO Mix
go [] = FilePath -> IO Mix
forall a. HasCallStack => FilePath -> a
error FilePath
"Cannot find mix file"
go (FilePath
d:[FilePath]
ds) = do
Either FilePath Mix
et_mix <- FilePath -> IO (Either FilePath Mix)
parse (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
mixname) IO (Either FilePath Mix)
-> (IOException -> IO (Either FilePath Mix))
-> IO (Either FilePath Mix)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` IOException -> IO (Either FilePath Mix)
forall {f :: * -> *} {a} {p} {b}.
(Applicative f, IsString a) =>
p -> f (Either a b)
handler
case Either FilePath Mix
et_mix of
Right Mix
mix -> Mix -> IO Mix
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mix
mix
Left FilePath
_err -> [FilePath] -> IO Mix
go [FilePath]
ds
newtype P a =
P {forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP :: forall r. (String -> r)
-> (a -> ByteString -> r)
-> ByteString
-> r}
instance Functor P where
fmap :: forall a b. (a -> b) -> P a -> P b
fmap a -> b
f P a
p = (forall r.
(FilePath -> r) -> (b -> ByteString -> r) -> ByteString -> r)
-> P b
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err b -> ByteString -> r
ok -> P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
p FilePath -> r
err (b -> ByteString -> r
ok (b -> ByteString -> r) -> (a -> b) -> a -> ByteString -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
{-# INLINE fmap #-}
instance Applicative P where
pure :: forall a. a -> P a
pure a
x = (forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
_ a -> ByteString -> r
ok -> a -> ByteString -> r
ok a
x)
{-# INLINE pure #-}
P (a -> b)
pf <*> :: forall a b. P (a -> b) -> P a -> P b
<*> P a
pa = (forall r.
(FilePath -> r) -> (b -> ByteString -> r) -> ByteString -> r)
-> P b
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err b -> ByteString -> r
ok -> P (a -> b)
-> forall r.
(FilePath -> r) -> ((a -> b) -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P (a -> b)
pf FilePath -> r
err (\a -> b
f -> P b
-> forall r.
(FilePath -> r) -> (b -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP ((a -> b) -> P a -> P b
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f P a
pa) FilePath -> r
err b -> ByteString -> r
ok))
{-# INLINE (<*>) #-}
instance Monad P where
P a
m >>= :: forall a b. P a -> (a -> P b) -> P b
>>= a -> P b
k = (forall r.
(FilePath -> r) -> (b -> ByteString -> r) -> ByteString -> r)
-> P b
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err b -> ByteString -> r
ok -> P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
m FilePath -> r
err (\a
x -> P b
-> forall r.
(FilePath -> r) -> (b -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP (a -> P b
k a
x) FilePath -> r
err b -> ByteString -> r
ok))
{-# INLINE (>>=) #-}
instance Alternative P where
empty :: forall a. P a
empty = (forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err a -> ByteString -> r
_ ByteString
_ -> FilePath -> r
err FilePath
"Alternative.empty")
{-# INLINE empty #-}
P a
p1 <|> :: forall a. P a -> P a -> P a
<|> P a
p2 = (forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err a -> ByteString -> r
go ByteString
bs -> P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
p1 (\FilePath
_ -> P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
p2 FilePath -> r
err a -> ByteString -> r
go ByteString
bs) a -> ByteString -> r
go ByteString
bs)
{-# INLINE (<|>) #-}
runEitherP :: P a -> ByteString -> Either String a
runEitherP :: forall a. P a -> ByteString -> Either FilePath a
runEitherP P a
p = P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
p FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (\a
a ByteString
_ -> a -> Either FilePath a
forall a b. b -> Either a b
Right a
a)
runMaybeP :: P a -> ByteString -> Maybe a
runMaybeP :: forall a. P a -> ByteString -> Maybe a
runMaybeP P a
p = P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
forall a.
P a
-> forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r
runP P a
p (Maybe a -> FilePath -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (\a
a ByteString
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a)
failP :: String -> P a
failP :: forall a. FilePath -> P a
failP FilePath
msg = (forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err a -> ByteString -> r
_ ByteString
_ -> FilePath -> r
err FilePath
msg)
{-# INLINABLE failP #-}
char :: Char -> P ()
char :: Char -> P ()
char Char
c =
(forall r.
(FilePath -> r) -> (() -> ByteString -> r) -> ByteString -> r)
-> P ()
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err () -> ByteString -> r
ok ByteString
bs ->
case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
Just (Char
c', ByteString
bs') | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' -> () -> ByteString -> r
ok () ByteString
bs'
Maybe (Char, ByteString)
_ -> FilePath -> r
err (FilePath
"char: failed to get " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> FilePath
forall a. Show a => a -> FilePath
show Char
c))
{-# INLINABLE char #-}
bytes :: ByteString -> P ()
bytes :: ByteString -> P ()
bytes ByteString
target =
(forall r.
(FilePath -> r) -> (() -> ByteString -> r) -> ByteString -> r)
-> P ()
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err () -> ByteString -> r
ok ByteString
bs ->
case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
target) ByteString
bs of
(ByteString
pre, ByteString
post) | ByteString
pre ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
target -> () -> ByteString -> r
ok () ByteString
post
(ByteString, ByteString)
_ -> FilePath -> r
err (FilePath
"bytes: failed to parse `" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
target FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'"))
{-# INLINABLE bytes #-}
int :: P Int
int :: P Int
int =
(forall r.
(FilePath -> r) -> (Int -> ByteString -> r) -> ByteString -> r)
-> P Int
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
err Int -> ByteString -> r
ok ByteString
bs ->
case ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
bs of
Just (Int
n, ByteString
bs') -> Int -> ByteString -> r
ok Int
n ByteString
bs'
Maybe (Int, ByteString)
_ -> FilePath -> r
err FilePath
"int: failed")
{-# INLINABLE int #-}
integer :: P Integer
integer :: P Integer
integer = (Int -> Integer) -> P Int -> P Integer
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral P Int
int
{-# INLINEABLE integer #-}
spaces :: P ()
spaces :: P ()
spaces = (forall r.
(FilePath -> r) -> (() -> ByteString -> r) -> ByteString -> r)
-> P ()
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
_ () -> ByteString -> r
ok ByteString
bs -> () -> ByteString -> r
ok () (ByteString -> ByteString
BS.dropSpace ByteString
bs))
{-# INLINABLE spaces #-}
takeWhile :: (Char -> Bool) -> P ByteString
takeWhile :: (Char -> Bool) -> P ByteString
takeWhile Char -> Bool
test =
(forall r.
(FilePath -> r)
-> (ByteString -> ByteString -> r) -> ByteString -> r)
-> P ByteString
forall a.
(forall r.
(FilePath -> r) -> (a -> ByteString -> r) -> ByteString -> r)
-> P a
P (\FilePath -> r
_ ByteString -> ByteString -> r
ok ByteString
bs -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Char -> Bool
test ByteString
bs of (ByteString
pre, ByteString
post) -> ByteString -> ByteString -> r
ok ByteString
pre ByteString
post)
{-# INLINABLE takeWhile #-}
sepBy :: Alternative f => f a -> f s -> f [a]
sepBy :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy f a
a f s
s = f a -> f s -> f [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
a f s
s f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# INLINEABLE sepBy #-}
sepBy1 :: Alternative f => f a -> f s -> f [a]
sepBy1 :: forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy1 f a
a f s
s = f [a]
go
where
go :: f [a]
go = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f ([a] -> [a]) -> f [a] -> f [a]
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((f s
s f s -> f [a] -> f [a]
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f [a]
go) f [a] -> f [a] -> f [a]
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
{-# INLINABLE sepBy1 #-}
doubleQuoted :: P a -> P a
doubleQuoted :: forall a. P a -> P a
doubleQuoted P a
p = Char -> P ()
char Char
'"' P () -> P a -> P a
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P a
p P a -> P () -> P a
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> P ()
char Char
'"'
{-# INLINEABLE doubleQuoted #-}
bracketed :: P a -> P a
bracketed :: forall a. P a -> P a
bracketed P a
p = Char -> P ()
char Char
'[' P () -> P a -> P a
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P a
p P a -> P () -> P a
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> P ()
char Char
']'
{-# INLINABLE bracketed #-}
parenthesized :: P a -> P a
parenthesized :: forall a. P a -> P a
parenthesized P a
p = Char -> P ()
char Char
'(' P () -> P a -> P a
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P a
p P a -> P () -> P a
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> P ()
char Char
')'
{-# INLINABLE parenthesized #-}
comma :: P ()
comma :: P ()
comma = Char -> P ()
char Char
','
{-# INLINABLE comma #-}
bool :: P Bool
bool :: P Bool
bool = P Bool
true P Bool -> P Bool -> P Bool
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P Bool
false
where
true :: P Bool
true = ByteString -> P ()
bytes ByteString
"True" P () -> Bool -> P Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
false :: P Bool
false = ByteString -> P ()
bytes ByteString
"False" P () -> Bool -> P Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
{-# INLINABLE bool #-}
string :: P String
string :: P FilePath
string = ByteString -> FilePath
BS.unpack (ByteString -> FilePath) -> P ByteString -> P FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P ByteString -> P ByteString
forall a. P a -> P a
doubleQuoted ((Char -> Bool) -> P ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
{-# INLINABLE string #-}
parseTix :: P Tix
parseTix :: P Tix
parseTix = do
ByteString -> P ()
bytes ByteString
"Tix" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces
[TixModule]
tix_modules <- P [TixModule] -> P [TixModule]
forall a. P a -> P a
bracketed (P TixModule -> P () -> P [TixModule]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy P TixModule
tixModule P ()
comma)
Tix -> P Tix
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TixModule] -> Tix
Tix [TixModule]
tix_modules)
tixModule :: P TixModule
tixModule :: P TixModule
tixModule = do
P ()
spaces P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> P ()
bytes ByteString
"TixModule" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces
FilePath
name <- P FilePath
string P FilePath -> P () -> P FilePath
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
Hash
hash <- (Int -> Hash) -> P Int -> P Hash
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Hash
forall a. HpcHash a => a -> Hash
toHash P Int
int P Hash -> P () -> P Hash
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
Int
size <- P Int
int P Int -> P () -> P Int
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
[Integer]
ticks <- P [Integer] -> P [Integer]
forall a. P a -> P a
bracketed (P Integer -> P () -> P [Integer]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy P Integer
integer P ()
comma)
TixModule -> P TixModule
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Hash -> Int -> [Integer] -> TixModule
TixModule FilePath
name Hash
hash Int
size [Integer]
ticks)
parseMix :: P Mix
parseMix :: P Mix
parseMix = do
ByteString -> P ()
bytes ByteString
"Mix" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces
FilePath
path <- P FilePath
string P FilePath -> P () -> P FilePath
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
UTCTime
ts <- P UTCTime
timestamp
Hash
hash <- (Int -> Hash) -> P Int -> P Hash
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Hash
forall a. HpcHash a => a -> Hash
toHash P Int
int P Hash -> P () -> P Hash
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
Int
tabstop <- P Int
int P Int -> P () -> P Int
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
FilePath -> UTCTime -> Hash -> Int -> [MixEntry] -> Mix
Mix FilePath
path UTCTime
ts Hash
hash Int
tabstop ([MixEntry] -> Mix) -> P [MixEntry] -> P Mix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P [MixEntry]
mixEntries
timestamp :: P UTCTime
timestamp :: P UTCTime
timestamp = do
ByteString
yyyy_mm_dd <- (Char -> Bool) -> P ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') P ByteString -> P () -> P ByteString
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
ByteString
hh_mm_ss_ps <- (Char -> Bool) -> P ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') P ByteString -> P () -> P ByteString
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
()
_tz <- ByteString -> P ()
bytes ByteString
"UTC" P () -> P () -> P ()
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces
let utc_str :: FilePath
utc_str = ByteString -> FilePath
BS.unpack ([ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString
yyyy_mm_dd, FilePath -> ByteString
BS.pack FilePath
" ", ByteString
hh_mm_ss_ps])
case Bool -> TimeLocale -> FilePath -> FilePath -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale FilePath
"%F %T%Q" FilePath
utc_str of
Just UTCTime
utc_time -> UTCTime -> P UTCTime
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
utc_time
Maybe UTCTime
Nothing -> FilePath -> P UTCTime
forall a. FilePath -> P a
failP FilePath
"timestamp: failed to parse UTC time"
{-# INLINABLE timestamp #-}
mixEntries :: P [MixEntry]
mixEntries :: P [MixEntry]
mixEntries = P [MixEntry] -> P [MixEntry]
forall a. P a -> P a
bracketed (P MixEntry -> P () -> P [MixEntry]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy P MixEntry
mixEntry P ()
comma)
{-# INLINABLE mixEntries #-}
mixEntry :: P MixEntry
mixEntry :: P MixEntry
mixEntry = P MixEntry -> P MixEntry
forall a. P a -> P a
parenthesized (P MixEntry -> P MixEntry) -> P MixEntry -> P MixEntry
forall a b. (a -> b) -> a -> b
$ do
HpcPos
pos <- P HpcPos
hpcPos
P ()
comma
BoxLabel
box <- P BoxLabel
boxLabel
MixEntry -> P MixEntry
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HpcPos
pos, BoxLabel
box)
{-# INLINABLE mixEntry #-}
hpcPos :: P HpcPos
hpcPos :: P HpcPos
hpcPos = do
Int
sl <- P Int
int
Char -> P ()
char Char
':'
Int
sc <- P Int
int
Char -> P ()
char Char
'-'
Int
el <- P Int
int
Char -> P ()
char Char
':'
Int
ec <- P Int
int
HpcPos -> P HpcPos
forall a. a -> P a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int, Int, Int, Int) -> HpcPos
toHpcPos (Int
sl, Int
sc, Int
el, Int
ec))
{-# INLINABLE hpcPos #-}
boxLabel :: P BoxLabel
boxLabel :: P BoxLabel
boxLabel = P BoxLabel
expBox P BoxLabel -> P BoxLabel -> P BoxLabel
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P BoxLabel
topLevelBox P BoxLabel -> P BoxLabel -> P BoxLabel
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P BoxLabel
localBox P BoxLabel -> P BoxLabel -> P BoxLabel
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P BoxLabel
binBox
where
expBox :: P BoxLabel
expBox = ByteString -> P ()
bytes ByteString
"ExpBox" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces P () -> P BoxLabel -> P BoxLabel
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> BoxLabel) -> P Bool -> P BoxLabel
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> BoxLabel
ExpBox P Bool
bool
topLevelBox :: P BoxLabel
topLevelBox = ByteString -> P ()
bytes ByteString
"TopLevelBox" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces P () -> P BoxLabel -> P BoxLabel
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FilePath] -> BoxLabel) -> P [FilePath] -> P BoxLabel
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> BoxLabel
TopLevelBox P [FilePath]
names
localBox :: P BoxLabel
localBox = ByteString -> P ()
bytes ByteString
"LocalBox" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces P () -> P BoxLabel -> P BoxLabel
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([FilePath] -> BoxLabel) -> P [FilePath] -> P BoxLabel
forall a b. (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> BoxLabel
LocalBox P [FilePath]
names
binBox :: P BoxLabel
binBox = ByteString -> P ()
bytes ByteString
"BinBox" P () -> P () -> P ()
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
spaces P () -> P BoxLabel -> P BoxLabel
forall a b. P a -> P b -> P b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(CondBox -> Bool -> BoxLabel
BinBox (CondBox -> Bool -> BoxLabel) -> P CondBox -> P (Bool -> BoxLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (P CondBox
condBox P CondBox -> P () -> P CondBox
forall a b. P a -> P b -> P a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
spaces) P (Bool -> BoxLabel) -> P Bool -> P BoxLabel
forall a b. P (a -> b) -> P a -> P b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Bool
bool)
{-# INLINABLE boxLabel #-}
names :: P [String]
names :: P [FilePath]
names = P [FilePath] -> P [FilePath]
forall a. P a -> P a
bracketed (P FilePath -> P () -> P [FilePath]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy P FilePath
string P ()
comma)
{-# INLINABLE names #-}
condBox :: P CondBox
condBox :: P CondBox
condBox = P CondBox
guard P CondBox -> P CondBox -> P CondBox
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P CondBox
cond P CondBox -> P CondBox -> P CondBox
forall a. P a -> P a -> P a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P CondBox
qual
where
guard :: P CondBox
guard = ByteString -> P ()
bytes ByteString
"GuardBinBox" P () -> CondBox -> P CondBox
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CondBox
GuardBinBox
cond :: P CondBox
cond = ByteString -> P ()
bytes ByteString
"CondBinBox" P () -> CondBox -> P CondBox
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CondBox
CondBinBox
qual :: P CondBox
qual = ByteString -> P ()
bytes ByteString
"QualBinBox" P () -> CondBox -> P CondBox
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CondBox
QualBinBox
{-# INLINABLE condBox #-}