{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
module Syslog.Ietf
(
Message (..)
, Element (..)
, Parameter (..)
, decode
, parser
) where
import Prelude hiding (id)
import Control.Monad (when)
import Control.Monad.ST.Run (runIntByteArrayST)
import Data.Bytes.Parser (Parser)
import Data.Bytes.Types (Bytes (Bytes))
import Data.Int (Int64)
import Data.Primitive (SmallArray)
import Data.Word (Word32, Word64, Word8)
import qualified Chronos
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.Bytes.Parser.Unsafe as Unsafe
import qualified Data.Bytes.Types
import qualified Data.Maybe.Unpacked.Numeric.Word32 as Word32
import qualified Data.Primitive as PM
import qualified Data.Primitive.Contiguous as C
data Message = Message
{ Message -> Word32
priority :: !Word32
, Message -> Word32
version :: !Word32
, Message -> OffsetDatetime
timestamp :: !Chronos.OffsetDatetime
, Message -> Bytes
hostname :: {-# UNPACK #-} !Bytes
, Message -> Bytes
application :: {-# UNPACK #-} !Bytes
, Message -> Maybe
processId :: {-# UNPACK #-} !Word32.Maybe
, Message -> Bytes
messageType :: {-# UNPACK #-} !Bytes
, Message -> SmallArray Element
structuredData :: {-# UNPACK #-} !(SmallArray Element)
, Message -> Bytes
message :: {-# UNPACK #-} !Bytes
}
deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)
data Element = Element
{ Element -> Bytes
id :: {-# UNPACK #-} !Bytes
, Element -> SmallArray Parameter
parameters :: {-# UNPACK #-} !(SmallArray Parameter)
}
deriving (Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show)
data Parameter = Parameter
{ Parameter -> Bytes
name :: {-# UNPACK #-} !Bytes
, Parameter -> Bytes
value :: {-# UNPACK #-} !Bytes
}
deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
(Int -> Parameter -> ShowS)
-> (Parameter -> String)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parameter -> ShowS
showsPrec :: Int -> Parameter -> ShowS
$cshow :: Parameter -> String
show :: Parameter -> String
$cshowList :: [Parameter] -> ShowS
showList :: [Parameter] -> ShowS
Show)
decode :: Bytes -> Maybe Message
decode :: Bytes -> Maybe Message
decode = (forall s. Parser () s Message) -> Bytes -> Maybe Message
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
Parser.parseBytesMaybe Parser () s Message
forall s. Parser () s Message
parser
parser :: Parser () s Message
parser :: forall s. Parser () s Message
parser = do
Word32
priority <- () -> Parser () s Word32
forall e s. e -> Parser e s Word32
takePriority ()
Word32
version <- () -> Parser () s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
OffsetDatetime
timestamp <- Parser () s OffsetDatetime
forall s. Parser () s OffsetDatetime
takeTimestamp
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Bytes
hostname <- () -> Parser () s Bytes
forall e s. e -> Parser e s Bytes
takeKeywordAndSpace ()
Bytes
application <- () -> Parser () s Bytes
forall e s. e -> Parser e s Bytes
takeKeywordAndSpace ()
Maybe
processId <-
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Parser () s Bool
-> (Bool -> Parser () s Maybe) -> Parser () s Maybe
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Maybe -> Parser () s Maybe
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
Word32.nothing
Bool
False ->
Parser () s Maybe -> Parser () s Maybe -> Parser () s Maybe
forall x s a e. Parser x s a -> Parser e s a -> Parser e s a
Parser.orElse
( do
Word32
w <- () -> Parser () s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Maybe -> Parser () s Maybe
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Maybe
Word32.just Word32
w)
)
( do
(Char -> Bool) -> Parser () s ()
forall e s. (Char -> Bool) -> Parser e s ()
Latin.skipWhile
(\Char
c -> (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'))
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Maybe -> Parser () s Maybe
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe
Word32.nothing
)
Bytes
messageType <-
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Parser () s Bool
-> (Bool -> Parser () s Bytes) -> Parser () s Bytes
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
ByteArray
array <- Parser () s ByteArray
forall e s. Parser e s ByteArray
Unsafe.expose
Bytes -> Parser () s Bytes
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes {ByteArray
array :: ByteArray
$sel:array:Bytes :: ByteArray
array, $sel:offset:Bytes :: Int
offset = Int
0, $sel:length:Bytes :: Int
length = Int
0}
Bool
False -> () -> Parser () s Bytes
forall e s. e -> Parser e s Bytes
takeKeywordAndSpace ()
SmallArray Element
structuredData <-
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') Parser () s Bool
-> (Bool -> Parser () s (SmallArray Element))
-> Parser () s (SmallArray Element)
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> SmallArray Element -> Parser () s (SmallArray Element)
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SmallArray Element
forall a. Monoid a => a
mempty
Bool
False -> Parser () s (SmallArray Element)
forall s. Parser () s (SmallArray Element)
takeStructuredData
Bytes
message <-
Parser () s Bool
forall e s. Parser e s Bool
Parser.isEndOfInput Parser () s Bool
-> (Bool -> Parser () s Bytes) -> Parser () s Bytes
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
ByteArray
arr <- Parser () s ByteArray
forall e s. Parser e s ByteArray
Unsafe.expose
Bytes -> Parser () s Bytes
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes {$sel:array:Bytes :: ByteArray
array = ByteArray
arr, $sel:offset:Bytes :: Int
offset = Int
0, $sel:length:Bytes :: Int
length = Int
0}
Bool
False -> do
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Parser () s Bytes
forall e s. Parser e s Bytes
Parser.remaining
Message -> Parser () s Message
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Message
{ Word32
$sel:priority:Message :: Word32
priority :: Word32
priority
, Word32
$sel:version:Message :: Word32
version :: Word32
version
, OffsetDatetime
$sel:timestamp:Message :: OffsetDatetime
timestamp :: OffsetDatetime
timestamp
, Bytes
$sel:hostname:Message :: Bytes
hostname :: Bytes
hostname
, Bytes
$sel:application:Message :: Bytes
application :: Bytes
application
, Maybe
$sel:processId:Message :: Maybe
processId :: Maybe
processId
, Bytes
$sel:messageType:Message :: Bytes
messageType :: Bytes
messageType
, SmallArray Element
$sel:structuredData:Message :: SmallArray Element
structuredData :: SmallArray Element
structuredData
, Bytes
$sel:message:Message :: Bytes
message :: Bytes
message
}
takeStructuredData :: Parser () s (SmallArray Element)
takeStructuredData :: forall s. Parser () s (SmallArray Element)
takeStructuredData = Int -> [Element] -> Parser () s (SmallArray Element)
forall s. Int -> [Element] -> Parser () s (SmallArray Element)
go Int
0 []
where
go :: Int -> [Element] -> Parser () s (SmallArray Element)
go :: forall s. Int -> [Element] -> Parser () s (SmallArray Element)
go !Int
n ![Element]
acc =
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[') Parser () s Bool
-> (Bool -> Parser () s (SmallArray Element))
-> Parser () s (SmallArray Element)
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
Bytes
id <- Parser () s Bytes
forall e s. Parser e s Bytes
takeKeyword
SmallArray Parameter
parameters <- Parser () s (SmallArray Parameter)
forall s. Parser () s (SmallArray Parameter)
takeParameters
let !e :: Element
e = Element {Bytes
$sel:id:Element :: Bytes
id :: Bytes
id, SmallArray Parameter
$sel:parameters:Element :: SmallArray Parameter
parameters :: SmallArray Parameter
parameters}
Int -> [Element] -> Parser () s (SmallArray Element)
forall s. Int -> [Element] -> Parser () s (SmallArray Element)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Element
e Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
acc)
Bool
False -> SmallArray Element -> Parser () s (SmallArray Element)
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SmallArray Element -> Parser () s (SmallArray Element))
-> SmallArray Element -> Parser () s (SmallArray Element)
forall a b. (a -> b) -> a -> b
$! Int -> [Element] -> SmallArray Element
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Int -> [a] -> arr a
C.unsafeFromListReverseN Int
n [Element]
acc
takeParameters :: Parser () s (SmallArray Parameter)
takeParameters :: forall s. Parser () s (SmallArray Parameter)
takeParameters = Int -> [Parameter] -> Parser () s (SmallArray Parameter)
forall s. Int -> [Parameter] -> Parser () s (SmallArray Parameter)
go Int
0 []
where
go :: Int -> [Parameter] -> Parser () s (SmallArray Parameter)
go :: forall s. Int -> [Parameter] -> Parser () s (SmallArray Parameter)
go !Int
n ![Parameter]
acc =
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']') Parser () s Bool
-> (Bool -> Parser () s (SmallArray Parameter))
-> Parser () s (SmallArray Parameter)
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> SmallArray Parameter -> Parser () s (SmallArray Parameter)
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SmallArray Parameter -> Parser () s (SmallArray Parameter))
-> SmallArray Parameter -> Parser () s (SmallArray Parameter)
forall a b. (a -> b) -> a -> b
$! Int -> [Parameter] -> SmallArray Parameter
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Int -> [a] -> arr a
C.unsafeFromListReverseN Int
n [Parameter]
acc
Bool
False -> do
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
Bytes
name <- Parser () s Bytes
forall s. Parser () s Bytes
takeKeywordAndEquals
Bytes
value <- Parser () s Bytes
forall s. Parser () s Bytes
takeParameterValue
let !p :: Parameter
p = Parameter {Bytes
$sel:name:Parameter :: Bytes
name :: Bytes
name, Bytes
$sel:value:Parameter :: Bytes
value :: Bytes
value}
Int -> [Parameter] -> Parser () s (SmallArray Parameter)
forall s. Int -> [Parameter] -> Parser () s (SmallArray Parameter)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Parameter
p Parameter -> [Parameter] -> [Parameter]
forall a. a -> [a] -> [a]
: [Parameter]
acc)
takeParameterValue :: Parser () s Bytes
takeParameterValue :: forall s. Parser () s Bytes
takeParameterValue = do
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'"'
Int
start <- Parser () s Int
forall e s. Parser e s Int
Unsafe.cursor
() -> Word8 -> Word8 -> Parser () s Bool
forall e s. e -> Word8 -> Word8 -> Parser e s Bool
Parser.skipTrailedBy2 () Word8
0x22 Word8
0x5C Parser () s Bool
-> (Bool -> Parser () s Bytes) -> Parser () s Bytes
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> do
Int
end <- Parser () s Int
forall e s. Parser e s Int
Unsafe.cursor
let !len :: Int
len = (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
ByteArray
arr <- Parser () s ByteArray
forall e s. Parser e s ByteArray
Unsafe.expose
Bytes -> Parser () s Bytes
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bytes {$sel:array:Bytes :: ByteArray
array = ByteArray
arr, $sel:offset:Bytes :: Int
offset = Int
start, $sel:length:Bytes :: Int
length = Int
len}
Bool
True -> do
Char
c <- () -> Parser () s Char
forall e s. e -> Parser e s Char
Latin.any ()
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
then () -> Parser () s ()
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else () -> Parser () s ()
forall e s a. e -> Parser e s a
Parser.fail ()
Parser () s ()
forall s. Parser () s ()
consumeThroughUnescapedQuote
Int
end <- Parser () s Int
forall e s. Parser e s Int
Unsafe.cursor
let !len :: Int
len = (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
ByteArray
arr <- Parser () s ByteArray
forall e s. Parser e s ByteArray
Unsafe.expose
let bs :: Bytes
bs = Bytes {$sel:array:Bytes :: ByteArray
array = ByteArray
arr, $sel:offset:Bytes :: Int
offset = Int
start, $sel:length:Bytes :: Int
length = Int
len}
Bytes -> Parser () s Bytes
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> Parser () s Bytes) -> Bytes -> Parser () s Bytes
forall a b. (a -> b) -> a -> b
$! Bytes -> Bytes
removeEscapeSequences Bytes
bs
consumeThroughUnescapedQuote :: Parser () s ()
consumeThroughUnescapedQuote :: forall s. Parser () s ()
consumeThroughUnescapedQuote =
() -> Word8 -> Word8 -> Parser () s Bool
forall e s. e -> Word8 -> Word8 -> Parser e s Bool
Parser.skipTrailedBy2 () Word8
0x22 Word8
0x5C Parser () s Bool -> (Bool -> Parser () s ()) -> Parser () s ()
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> () -> Parser () s ()
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool
True -> do
Char
c <- () -> Parser () s Char
forall e s. e -> Parser e s Char
Latin.any ()
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
then Parser () s ()
forall s. Parser () s ()
consumeThroughUnescapedQuote
else () -> Parser () s ()
forall e s a. e -> Parser e s a
Parser.fail ()
removeEscapeSequences :: Bytes -> Bytes
removeEscapeSequences :: Bytes -> Bytes
removeEscapeSequences Bytes {ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: ByteArray
array, $sel:offset:Bytes :: Bytes -> Int
offset = Int
off0, $sel:length:Bytes :: Bytes -> Int
length = Int
len0} =
let (Int
lengthX, ByteArray
arrayX) = (forall s. ST s (Int, ByteArray)) -> (Int, ByteArray)
runIntByteArrayST ((forall s. ST s (Int, ByteArray)) -> (Int, ByteArray))
-> (forall s. ST s (Int, ByteArray)) -> (Int, ByteArray)
forall a b. (a -> b) -> a -> b
$ do
MutableByteArray (PrimState (ST s))
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PM.newByteArray Int
len0
let go :: Int -> Int -> t -> ST s Int
go !Int
ixSrc !Int
ixDst !t
len = case t
len of
t
0 -> Int -> ST s Int
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ixDst
t
_ -> do
let Word8
w :: Word8 = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
array Int
ixSrc
case Word8
w of
Word8
0x5C -> case ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
PM.indexByteArray ByteArray
array (Int
ixSrc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) :: Word8 of
Word8
0x5C -> do
MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray (PrimState (ST s))
dst Int
ixDst (Word8
0x5C :: Word8)
Int -> Int -> t -> ST s Int
go (Int
ixSrc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
2)
Word8
0x22 -> do
MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray (PrimState (ST s))
dst Int
ixDst (Word8
0x22 :: Word8)
Int -> Int -> t -> ST s Int
go (Int
ixSrc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
2)
Word8
_ -> String -> ST s Int
forall a. String -> a
errorWithoutStackTrace String
"Syslog.Ietf.removeEscapeSequences: invariant violated"
Word8
_ -> do
MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PM.writeByteArray MutableByteArray (PrimState (ST s))
dst Int
ixDst Word8
w
Int -> Int -> t -> ST s Int
go (Int
ixSrc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ixDst Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
Int
lenDst <- Int -> Int -> Int -> ST s Int
forall {t}. (Eq t, Num t) => Int -> Int -> t -> ST s Int
go Int
off0 Int
0 Int
len0
MutableByteArray (PrimState (ST s)) -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> m ()
PM.shrinkMutableByteArray MutableByteArray (PrimState (ST s))
dst Int
lenDst
ByteArray
dst' <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PM.unsafeFreezeByteArray MutableByteArray (PrimState (ST s))
dst
(Int, ByteArray) -> ST s (Int, ByteArray)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
lenDst, ByteArray
dst')
in Bytes {$sel:array:Bytes :: ByteArray
array = ByteArray
arrayX, $sel:length:Bytes :: Int
length = Int
lengthX, $sel:offset:Bytes :: Int
offset = Int
0}
takePriority :: e -> Parser e s Word32
takePriority :: forall e s. e -> Parser e s Word32
takePriority e
e = do
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'<'
Word32
priority <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 e
e
e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'>'
Word32 -> Parser e s Word32
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
priority
takeKeywordAndSpace :: e -> Parser e s Bytes
takeKeywordAndSpace :: forall e s. e -> Parser e s Bytes
takeKeywordAndSpace e
e =
e -> Char -> Parser e s Bytes
forall e s. e -> Char -> Parser e s Bytes
Latin.takeTrailedBy e
e Char
' '
takeKeyword :: Parser e s Bytes
takeKeyword :: forall e s. Parser e s Bytes
takeKeyword =
(Word8 -> Bool) -> Parser e s Bytes
forall e s. (Word8 -> Bool) -> Parser e s Bytes
Parser.takeWhile (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x20)
takeKeywordAndEquals :: Parser () s Bytes
takeKeywordAndEquals :: forall s. Parser () s Bytes
takeKeywordAndEquals =
() -> Char -> Parser () s Bytes
forall e s. e -> Char -> Parser e s Bytes
Latin.takeTrailedBy () Char
'='
takeTimestamp :: Parser () s Chronos.OffsetDatetime
takeTimestamp :: forall s. Parser () s OffsetDatetime
takeTimestamp = do
Word
year <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
Word
month' <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
let !month :: Word
month = Word
month' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
month Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
12) (() -> Parser () s ()
forall e s a. e -> Parser e s a
Parser.fail ())
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
Word
day <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'T'
Word
hour <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
Word
minute <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
Word
sec <- () -> Parser () s Word
forall e s. e -> Parser e s Word
Latin.decWord ()
let date :: Date
date =
Year -> Month -> DayOfMonth -> Date
Chronos.Date
(Int -> Year
Chronos.Year (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
year))
(Int -> Month
Chronos.Month (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
month))
(Int -> DayOfMonth
Chronos.DayOfMonth (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
day))
!Word64
nanos <-
(Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Parser () s Bool
-> (Bool -> Parser () s Word64) -> Parser () s Word64
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
(Int
n, Word64
w) <- Parser () s Word64 -> Parser () s (Int, Word64)
forall e s a. Parser e s a -> Parser e s (Int, a)
Parser.measure (() -> Parser () s Word64
forall e s. e -> Parser e s Word64
Latin.decWord64 ())
Bool -> Parser () s () -> Parser () s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (() -> Parser () s ()
forall e s a. e -> Parser e s a
Parser.fail ())
let go :: t -> t -> t
go !t
acc !t
b = case t
b of
t
0 -> t
acc
t
_ -> t -> t -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
* t
10) (t
b t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
!ns :: Word64
ns = Word64 -> Int -> Word64
forall {t} {t}. (Eq t, Num t, Num t) => t -> t -> t
go Word64
w (Int
9 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
Word64 -> Parser () s Word64
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
ns
Bool
False -> Word64 -> Parser () s Word64
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
0
Int
off <-
() -> Parser () s Char
forall e s. e -> Parser e s Char
Latin.any () Parser () s Char -> (Char -> Parser () s Int) -> Parser () s Int
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Char
'Z' -> Int -> Parser () s Int
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
Char
'+' -> Parser () s Int
forall s. Parser () s Int
parserOffset
Char
'-' -> do
!Int
off <- Parser () s Int
forall s. Parser () s Int
parserOffset
Int -> Parser () s Int
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int
forall a. Num a => a -> a
negate Int
off)
Char
_ -> () -> Parser () s Int
forall e s a. e -> Parser e s a
Parser.fail ()
OffsetDatetime -> Parser () s OffsetDatetime
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OffsetDatetime -> Parser () s OffsetDatetime)
-> OffsetDatetime -> Parser () s OffsetDatetime
forall a b. (a -> b) -> a -> b
$!
Datetime -> Offset -> OffsetDatetime
Chronos.OffsetDatetime
( Date -> TimeOfDay -> Datetime
Chronos.Datetime Date
date (TimeOfDay -> Datetime) -> TimeOfDay -> Datetime
forall a b. (a -> b) -> a -> b
$
Int -> Int -> Int64 -> TimeOfDay
Chronos.TimeOfDay
(Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
hour)
(Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
minute)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64 (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sec Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
nanos))
)
(Int -> Offset
Chronos.Offset Int
off)
parserOffset :: Parser () s Int
parserOffset :: forall s. Parser () s Int
parserOffset = do
Word8
h <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
() -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
Word8
m <- () -> Parser () s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 ()
let !r :: Int
r = ((forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Int Word8
m
Int -> Parser () s Int
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
r