-- | A simple and unambigous text encoding for Osc.
module Sound.Osc.Text where

import Control.Monad {- base -}
import Data.Char {- base -}
import Numeric {- base -}
import Text.Printf {- base -}

import qualified Text.ParserCombinators.Parsec as P {- parsec -}

import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Packet  {- hosc3 -}
import Sound.Osc.Time  {- hosc3 -}

-- | Precision value for floating point numbers.
type FpPrecision = Maybe Int

{- | Variant of 'showFFloat' that deletes trailing zeros.

> map (showFloatWithPrecision (Just 4)) [1, 2.0, pi] == ["1.0", "2.0", "3.1416"]
-}
showFloatWithPrecision :: RealFloat n => FpPrecision -> n -> String
showFloatWithPrecision :: forall n. RealFloat n => FpPrecision -> n -> [Char]
showFloatWithPrecision FpPrecision
p n
n =
    let s :: [Char]
s = FpPrecision -> n -> ShowS
forall a. RealFloat a => FpPrecision -> a -> ShowS
showFFloat FpPrecision
p n
n [Char]
""
        s' :: [Char]
s' = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') (ShowS
forall a. [a] -> [a]
reverse [Char]
s)
    in case [Char]
s' of
         Char
'.':[Char]
_ -> ShowS
forall a. [a] -> [a]
reverse (Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
s')
         [Char]
_ -> ShowS
forall a. [a] -> [a]
reverse [Char]
s'

{- | Hex encoded byte sequence.

> showBytes [0, 15, 16, 144, 255] == "000f1090ff"
-}
showBytes :: [Int] -> String
showBytes :: [Int] -> [Char]
showBytes = (Int -> [Char]) -> [Int] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%02x")

{- | Escape whites space (space, tab, newline) and the escape character (backslash).

> mapM_ (putStrLn .  escapeString) ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"]
-}
escapeString :: String -> String
escapeString :: ShowS
escapeString [Char]
txt =
  case [Char]
txt of
    [] -> []
    Char
c:[Char]
txt' -> if Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"\\\t\n " then Char
'\\'  Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escapeString [Char]
txt' else Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escapeString [Char]
txt'

{- | Printer for Datum.

> aDatumSeq = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16], TimeStamp 100.0]
> map (showDatum (Just 5)) aDatumSeq == ["1","1.2","str","00904060","0c10","429496729600"]
-}
showDatum :: FpPrecision -> Datum -> String
showDatum :: FpPrecision -> Datum -> [Char]
showDatum FpPrecision
p Datum
d =
    case Datum
d of
      Int32 Int32
n -> Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
n
      Int64 Int64
n -> Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
n
      Float Float
n -> FpPrecision -> Float -> [Char]
forall n. RealFloat n => FpPrecision -> n -> [Char]
showFloatWithPrecision FpPrecision
p Float
n
      Double Double
n -> FpPrecision -> Double -> [Char]
forall n. RealFloat n => FpPrecision -> n -> [Char]
showFloatWithPrecision FpPrecision
p Double
n
      AsciiString Ascii
s -> ShowS
escapeString (Ascii -> [Char]
ascii_to_string Ascii
s)
      Blob Blob
s -> [Int] -> [Char]
showBytes (Blob -> [Int]
blob_unpack_int Blob
s)
      TimeStamp Double
t -> Ntp64 -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Ntp64
ntpr_to_ntpi Double
t)
      Midi MidiData
m -> [Int] -> [Char]
showBytes (MidiData -> [Int]
midi_unpack_int MidiData
m)

{- | Printer for Message.

> aMessage = Message "/addr" [Int32 1, Int64 2, Float 3, Double 4, string "five", blob [6, 7], midi (8, 9, 10, 11)]
> showMessage (Just 4) aMessage

> aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3], Message "/s_new" [string "sine", Int32 (-1), Int32 1, Int32 1]]
> map (showMessage (Just 4)) aMessageSeq
-}
showMessage :: FpPrecision -> Message -> String
showMessage :: FpPrecision -> Message -> [Char]
showMessage FpPrecision
precision Message
aMessage =
  [[Char]] -> [Char]
unwords
  [Message -> [Char]
messageAddress Message
aMessage
  ,Message -> [Char]
messageSignature Message
aMessage
  ,[[Char]] -> [Char]
unwords ((Datum -> [Char]) -> [Datum] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (FpPrecision -> Datum -> [Char]
showDatum FpPrecision
precision) (Message -> [Datum]
messageDatum Message
aMessage))]

{- | Printer for Bundle

> aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]
> showBundle (Just 4) aBundle
-}
showBundle :: FpPrecision -> Bundle -> String
showBundle :: FpPrecision -> Bundle -> [Char]
showBundle FpPrecision
precision Bundle
aBundle =
  let messages :: [Message]
messages = Bundle -> [Message]
bundleMessages Bundle
aBundle
  in [[Char]] -> [Char]
unwords
     [[Char]
"#bundle"
     ,Ntp64 -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Ntp64
ntpr_to_ntpi (Bundle -> Double
bundleTime Bundle
aBundle))
     ,Int -> [Char]
forall a. Show a => a -> [Char]
show ([Message] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Message]
messages)
     ,[[Char]] -> [Char]
unwords ((Message -> [Char]) -> [Message] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (FpPrecision -> Message -> [Char]
showMessage FpPrecision
precision) [Message]
messages)]

-- | Printer for Packet.
showPacket :: FpPrecision -> Packet -> String
showPacket :: FpPrecision -> Packet -> [Char]
showPacket FpPrecision
precision = (Message -> [Char]) -> (Bundle -> [Char]) -> Packet -> [Char]
forall a. (Message -> a) -> (Bundle -> a) -> Packet -> a
at_packet (FpPrecision -> Message -> [Char]
showMessage FpPrecision
precision) (FpPrecision -> Bundle -> [Char]
showBundle FpPrecision
precision)

-- * Parser

-- | A character parser with no user state.
type P a = P.GenParser Char () a

-- | Run p then q, returning result of p.
(>>~) :: Monad m => m t -> m u -> m t
m t
p >>~ :: forall (m :: * -> *) t u. Monad m => m t -> m u -> m t
>>~ m u
q = m t
p m t -> (t -> m t) -> m t
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t
x -> m u
q m u -> m t -> m t
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> m t
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return t
x

-- | /p/ as lexeme, i.e. consuming any trailing white space.
lexemeP :: P t -> P t
lexemeP :: forall t. P t -> P t
lexemeP P t
p = P t
p P t -> ParsecT [Char] () Identity [Char] -> P t
forall (m :: * -> *) t u. Monad m => m t -> m u -> m t
>>~ ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space

-- | Any non-space character.  Allow escaped space.
stringCharP :: P Char
stringCharP :: ParsecT [Char] () Identity Char
stringCharP = (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\\' ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall a b.
ParsecT [Char] () Identity a
-> ParsecT [Char] () Identity b -> ParsecT [Char] () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space) ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (Char -> Bool) -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c))

-- | Parser for string.
stringP :: P String
stringP :: ParsecT [Char] () Identity [Char]
stringP = ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall t. P t -> P t
lexemeP (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT [Char] () Identity Char
stringCharP)

-- | Parser for Osc address.
oscAddressP :: P String
oscAddressP :: ParsecT [Char] () Identity [Char]
oscAddressP = do
  Char
forwardSlash <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'/'
  [Char]
address <- ParsecT [Char] () Identity [Char]
stringP
  [Char] -> ParsecT [Char] () Identity [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
forwardSlash Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
address)

-- | Parser for Osc signature.
oscSignatureP :: P String
oscSignatureP :: ParsecT [Char] () Identity [Char]
oscSignatureP = ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall t. P t -> P t
lexemeP (do
  Char
comma <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
','
  [Char]
types <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ([Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
"ifsbhtdm") -- 1.0 = ifsb 2.0 = htdm
  [Char] -> ParsecT [Char] () Identity [Char]
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
comma Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
types))

-- | Parser for decimal digit.
digitP :: P Char
digitP :: ParsecT [Char] () Identity Char
digitP = [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
"0123456789"

allowNegativeP :: Num n => P n -> P n
allowNegativeP :: forall n. Num n => P n -> P n
allowNegativeP P n
p = do
  let optionMaybe :: ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s u m a
x = Maybe a -> ParsecT s u m (Maybe a) -> ParsecT s u m (Maybe a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Maybe a
forall a. Maybe a
Nothing ((a -> Maybe a) -> ParsecT s u m a -> ParsecT s u m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just ParsecT s u m a
x) -- hugs...
  Maybe Char
maybeNegative <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity (Maybe Char)
forall {s} {m :: * -> *} {t} {u} {a}.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'-')
  n
number <- P n
p
  n -> P n
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (n -> (Char -> n) -> Maybe Char -> n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe n
number (n -> Char -> n
forall a b. a -> b -> a
const (n -> n
forall a. Num a => a -> a
negate n
number)) Maybe Char
maybeNegative)

-- | Parser for non-negative integer.
nonNegativeIntegerP :: (Integral n, Read n) => P n
nonNegativeIntegerP :: forall n. (Integral n, Read n) => P n
nonNegativeIntegerP = P n -> P n
forall t. P t -> P t
lexemeP (([Char] -> n) -> ParsecT [Char] () Identity [Char] -> P n
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> n
forall a. Read a => [Char] -> a
read (ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT [Char] () Identity Char
digitP))

-- | Parser for integer.
integerP :: (Integral n, Read n) => P n
integerP :: forall n. (Integral n, Read n) => P n
integerP = P n -> P n
forall n. Num n => P n -> P n
allowNegativeP P n
forall n. (Integral n, Read n) => P n
nonNegativeIntegerP

-- | Parser for non-negative float.
nonNegativeFloatP :: (Fractional n, Read n) => P n
nonNegativeFloatP :: forall n. (Fractional n, Read n) => P n
nonNegativeFloatP = P n -> P n
forall t. P t -> P t
lexemeP (do
  [Char]
integerPart <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT [Char] () Identity Char
digitP
  Char
_ <- Char -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'.'
  [Char]
fractionalPart <- ParsecT [Char] () Identity Char
-> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT [Char] () Identity Char
digitP
  n -> P n
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> n
forall a. Read a => [Char] -> a
read ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
integerPart, [Char]
".", [Char]
fractionalPart])))

-- | Parser for non-negative float.
floatP :: (Fractional n, Read n) => P n
floatP :: forall n. (Fractional n, Read n) => P n
floatP = P n -> P n
forall n. Num n => P n -> P n
allowNegativeP P n
forall n. (Fractional n, Read n) => P n
nonNegativeFloatP

-- | Parser for hexadecimal digit.
hexdigitP :: P Char
hexdigitP :: ParsecT [Char] () Identity Char
hexdigitP = [Char] -> ParsecT [Char] () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
P.oneOf [Char]
"0123456789abcdef"

-- | Byte parser.
byteP :: (Integral n, Read n) => P n
byteP :: forall n. (Integral n, Read n) => P n
byteP = do
  Char
c1 <- ParsecT [Char] () Identity Char
hexdigitP
  Char
c2 <- ParsecT [Char] () Identity Char
hexdigitP
  case ReadS n
forall a. (Eq a, Num a) => ReadS a
readHex [Char
c1, Char
c2] of
    [(n
r,[Char]
"")] -> n -> P n
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return n
r
    [(n, [Char])]
_ -> [Char] -> P n
forall a. HasCallStack => [Char] -> a
error [Char]
"byteP?"

-- | Byte sequence parser.
byteSeqP :: (Integral n, Read n) => P [n]
byteSeqP :: forall n. (Integral n, Read n) => P [n]
byteSeqP = P [n] -> P [n]
forall t. P t -> P t
lexemeP (ParsecT [Char] () Identity n -> P [n]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT [Char] () Identity n
forall n. (Integral n, Read n) => P n
byteP)

-- | Datum parser.
datumP :: Char -> P Datum
datumP :: Char -> P Datum
datumP Char
typeChar = do
  case Char
typeChar of
    Char
'i' -> (Int32 -> Datum) -> ParsecT [Char] () Identity Int32 -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 ParsecT [Char] () Identity Int32
forall n. (Integral n, Read n) => P n
integerP
    Char
'f' -> (Float -> Datum) -> ParsecT [Char] () Identity Float -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float ParsecT [Char] () Identity Float
forall n. (Fractional n, Read n) => P n
floatP
    Char
's' -> ([Char] -> Datum) -> ParsecT [Char] () Identity [Char] -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Datum
string ParsecT [Char] () Identity [Char]
stringP
    Char
'b' -> ([Word8] -> Datum) -> ParsecT [Char] () Identity [Word8] -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> Datum
blob ParsecT [Char] () Identity [Word8]
forall n. (Integral n, Read n) => P [n]
byteSeqP
    Char
'h' -> (Int64 -> Datum) -> ParsecT [Char] () Identity Int64 -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 ParsecT [Char] () Identity Int64
forall n. (Integral n, Read n) => P n
integerP
    Char
'd' -> (Double -> Datum) -> ParsecT [Char] () Identity Double -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Datum
Double ParsecT [Char] () Identity Double
forall n. (Fractional n, Read n) => P n
floatP
    Char
'm' -> ([Word8] -> Datum) -> ParsecT [Char] () Identity [Word8] -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MidiData -> Datum
Midi (MidiData -> Datum) -> ([Word8] -> MidiData) -> [Word8] -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> MidiData
midi_pack) (Int
-> ParsecT [Char] () Identity Word8
-> ParsecT [Char] () Identity [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 ParsecT [Char] () Identity Word8
forall n. (Integral n, Read n) => P n
byteP)
    Char
't' -> (Ntp64 -> Datum) -> ParsecT [Char] () Identity Ntp64 -> P Datum
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Datum
TimeStamp (Double -> Datum) -> (Ntp64 -> Double) -> Ntp64 -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ntp64 -> Double
ntpi_to_ntpr) ParsecT [Char] () Identity Ntp64
forall n. (Integral n, Read n) => P n
integerP
    Char
_ -> [Char] -> P Datum
forall a. HasCallStack => [Char] -> a
error [Char]
"datumP: type?"

-- | Message parser.
messageP :: P Message
messageP :: P Message
messageP = do
  [Char]
address <- ParsecT [Char] () Identity [Char]
oscAddressP
  [Char]
typeSignature <- ParsecT [Char] () Identity [Char]
oscSignatureP
  [Datum]
datum <- (Char -> P Datum) -> [Char] -> ParsecT [Char] () Identity [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> P Datum
datumP (ShowS
forall a. HasCallStack => [a] -> [a]
tail [Char]
typeSignature)
  Message -> P Message
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [Datum] -> Message
Message [Char]
address [Datum]
datum)

-- | Bundle tag parser.
bundleTagP :: P String
bundleTagP :: ParsecT [Char] () Identity [Char]
bundleTagP = ParsecT [Char] () Identity [Char]
-> ParsecT [Char] () Identity [Char]
forall t. P t -> P t
lexemeP ([Char] -> ParsecT [Char] () Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string [Char]
"#bundle")

-- | Bundle parser.
bundleP :: P Bundle
bundleP :: P Bundle
bundleP = do
  [Char]
_ <- ParsecT [Char] () Identity [Char]
bundleTagP
  Double
timestamp <- (Ntp64 -> Double)
-> ParsecT [Char] () Identity Ntp64
-> ParsecT [Char] () Identity Double
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ntp64 -> Double
ntpi_to_ntpr ParsecT [Char] () Identity Ntp64
forall n. (Integral n, Read n) => P n
integerP
  Int
messageCount <- P Int
forall n. (Integral n, Read n) => P n
integerP
  [Message]
messages <- Int -> P Message -> ParsecT [Char] () Identity [Message]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
messageCount P Message
messageP
  Bundle -> P Bundle
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> [Message] -> Bundle
Bundle Double
timestamp [Message]
messages)

-- | Packet parser.
packetP :: P Packet
packetP :: P Packet
packetP = ((Bundle -> Packet) -> P Bundle -> P Packet
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bundle -> Packet
Packet_Bundle P Bundle
bundleP) P Packet -> P Packet -> P Packet
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ((Message -> Packet) -> P Message -> P Packet
forall a b.
(a -> b)
-> ParsecT [Char] () Identity a -> ParsecT [Char] () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> Packet
Packet_Message P Message
messageP)

-- | Run parser.
runP :: P t -> String -> t
runP :: forall t. P t -> [Char] -> t
runP P t
p [Char]
txt =
  case P t -> [Char] -> [Char] -> Either ParseError t
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
P.parse P t
p [Char]
"" [Char]
txt of
    Left ParseError
err -> [Char] -> t
forall a. HasCallStack => [Char] -> a
error (ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err)
    Right t
r -> t
r

{- | Run datum parser.

> parseDatum 'i' "-1" == Int32 (-1)
> parseDatum 'f' "-2.3" == Float (-2.3)
-}
parseDatum :: Char -> String -> Datum
parseDatum :: Char -> [Char] -> Datum
parseDatum Char
typ = P Datum -> [Char] -> Datum
forall t. P t -> [Char] -> t
runP (Char -> P Datum
datumP Char
typ)

{- | Run message parser.

> aMessageSeq = [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]
> map (parseMessage . showMessage (Just 4)) aMessageSeq  == aMessageSeq
-}
parseMessage :: String -> Message
parseMessage :: [Char] -> Message
parseMessage = P Message -> [Char] -> Message
forall t. P t -> [Char] -> t
runP P Message
messageP

{- | Run bundle parser.

> aBundle = Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]]
> parseBundle (showBundle (Just 4) aBundle) == aBundle
-}
parseBundle :: String -> Bundle
parseBundle :: [Char] -> Bundle
parseBundle = P Bundle -> [Char] -> Bundle
forall t. P t -> [Char] -> t
runP P Bundle
bundleP

{- | Run packet parser.

> aPacket = Packet_Bundle (Bundle 1 [Message "/c_set" [Int32 1, Float 2.3, Int64 4, Double 5.6], Message "/memset" [string "addr", blob [7, 8]]])
> parsePacket (showPacket (Just 4) aPacket) == aPacket
-}
parsePacket :: String -> Packet
parsePacket :: [Char] -> Packet
parsePacket = P Packet -> [Char] -> Packet
forall t. P t -> [Char] -> t
runP P Packet
packetP