-- | 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 Safe {- safe -}

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

import Sound.Osc.Datum {- hosc -}
import Sound.Osc.Packet {- hosc3 -}
import qualified Sound.Osc.Time as 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).

>>> map escapeString ["str", "str ", "st r", "s\tr", "s\\tr", "\nstr"]
["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.

>>> let 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
Time.ntpr_to_ntpi Double
t)
    Midi MidiData
m -> [Int] -> [Char]
showBytes (MidiData -> [Int]
midi_unpack_int MidiData
m)

{- | Printer for Message.

>>> let 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
"/addr ,ihfdsbm 1 2 3.0 4.0 five 0607 08090a0b"

>>> let 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
["/c_set ,if 1 2.3","/s_new ,siii sine -1 1 1"]
-}
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

>>> let 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
"#bundle 4294967296 2 /c_set ,ifhd 1 2.3 4 5.6 /memset ,sb addr 0708"
-}
showBundle :: FpPrecision -> BundleOf Message -> String
showBundle :: FpPrecision -> BundleOf Message -> [Char]
showBundle FpPrecision
precision BundleOf Message
aBundle =
  let messages :: [Message]
messages = BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages BundleOf Message
aBundle
  in [[Char]] -> [Char]
unwords
      [ [Char]
"#bundle"
      , Ntp64 -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Ntp64
Time.ntpr_to_ntpi (BundleOf Message -> Double
forall t. BundleOf t -> Double
bundleTime BundleOf Message
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 -> PacketOf Message -> String
showPacket :: FpPrecision -> PacketOf Message -> [Char]
showPacket FpPrecision
precision = (Message -> [Char])
-> (BundleOf Message -> [Char]) -> PacketOf Message -> [Char]
forall a t. (Message -> a) -> (BundleOf t -> a) -> PacketOf t -> a
at_packet (FpPrecision -> Message -> [Char]
showMessage FpPrecision
precision) (FpPrecision -> BundleOf Message -> [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
Time.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 ([Char] -> ShowS
forall a. HasCallStack => [Char] -> [a] -> [a]
Safe.tailNote [Char]
"messageP" [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 (BundleOf Message)
bundleP :: P (BundleOf Message)
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
Time.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
  BundleOf Message -> P (BundleOf Message)
forall a. a -> ParsecT [Char] () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> [Message] -> BundleOf Message
forall t. Double -> [t] -> BundleOf t
Bundle Double
timestamp [Message]
messages)

-- | Packet parser.
packetP :: P (PacketOf Message)
packetP :: P (PacketOf Message)
packetP = ((BundleOf Message -> PacketOf Message)
-> P (BundleOf Message) -> P (PacketOf Message)
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 BundleOf Message -> PacketOf Message
forall t. BundleOf t -> PacketOf t
Packet_Bundle P (BundleOf Message)
bundleP) P (PacketOf Message)
-> P (PacketOf Message) -> P (PacketOf Message)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ((Message -> PacketOf Message) -> P Message -> P (PacketOf Message)
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 -> PacketOf Message
forall t. Message -> PacketOf t
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)
True

>>> parseDatum 'f' "-2.3" == Float (-2.3)
True
-}
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.

>>> let 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
True
-}
parseMessage :: String -> Message
parseMessage :: [Char] -> Message
parseMessage = P Message -> [Char] -> Message
forall t. P t -> [Char] -> t
runP P Message
messageP

{- | Run bundle parser.

>>> let 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
True
-}
parseBundle :: String -> BundleOf Message
parseBundle :: [Char] -> BundleOf Message
parseBundle = P (BundleOf Message) -> [Char] -> BundleOf Message
forall t. P t -> [Char] -> t
runP P (BundleOf Message)
bundleP

{- | Run packet parser.

>>> let 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
True
-}
parsePacket :: String -> PacketOf Message
parsePacket :: [Char] -> PacketOf Message
parsePacket = P (PacketOf Message) -> [Char] -> PacketOf Message
forall t. P t -> [Char] -> t
runP P (PacketOf Message)
packetP