-- | Data type for OSC datum.
module Sound.OSC.Datum where

import Data.Char {- base -}
import Data.Int {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Word {- base -}
import Numeric {- base -}
import Text.Printf {- base -}
import Text.Read {- base -}

import qualified Data.ByteString.Lazy as Lazy {- bytestring -}
import qualified Data.ByteString.Char8 as Char8 {- bytestring -}

import qualified Sound.OSC.Time as Time {- hosc -}

-- * Datum

-- | Type enumerating Datum categories.
type Datum_Type = Char

-- | Type for ASCII strings (strict 'Char'8 'Char8.ByteString').
type ASCII = Char8.ByteString

-- | Type-specialised 'Char8.pack'.
ascii :: String -> ASCII
ascii :: String -> ASCII
ascii = String -> ASCII
Char8.pack

-- | Type-specialised 'Char8.unpack'.
ascii_to_string :: ASCII -> String
ascii_to_string :: ASCII -> String
ascii_to_string = ASCII -> String
Char8.unpack

-- | Type for 'Word8' arrays, these are stored with an 'Int32' length prefix.
type BLOB = Lazy.ByteString

-- | Type-specialised 'Lazy.pack'.
blob_pack ::  [Word8] -> BLOB
blob_pack :: [Word8] -> BLOB
blob_pack = [Word8] -> BLOB
Lazy.pack

-- | Type-specialised 'Lazy.unpack'.
blob_unpack :: BLOB -> [Word8]
blob_unpack :: BLOB -> [Word8]
blob_unpack = BLOB -> [Word8]
Lazy.unpack

-- | Four-byte midi message: port-id, status-byte, data, data.
data MIDI = MIDI !Word8 !Word8 !Word8 !Word8
    deriving (MIDI -> MIDI -> Bool
(MIDI -> MIDI -> Bool) -> (MIDI -> MIDI -> Bool) -> Eq MIDI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIDI -> MIDI -> Bool
$c/= :: MIDI -> MIDI -> Bool
== :: MIDI -> MIDI -> Bool
$c== :: MIDI -> MIDI -> Bool
Eq,Int -> MIDI -> ShowS
[MIDI] -> ShowS
MIDI -> String
(Int -> MIDI -> ShowS)
-> (MIDI -> String) -> ([MIDI] -> ShowS) -> Show MIDI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIDI] -> ShowS
$cshowList :: [MIDI] -> ShowS
show :: MIDI -> String
$cshow :: MIDI -> String
showsPrec :: Int -> MIDI -> ShowS
$cshowsPrec :: Int -> MIDI -> ShowS
Show,ReadPrec [MIDI]
ReadPrec MIDI
Int -> ReadS MIDI
ReadS [MIDI]
(Int -> ReadS MIDI)
-> ReadS [MIDI] -> ReadPrec MIDI -> ReadPrec [MIDI] -> Read MIDI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MIDI]
$creadListPrec :: ReadPrec [MIDI]
readPrec :: ReadPrec MIDI
$creadPrec :: ReadPrec MIDI
readList :: ReadS [MIDI]
$creadList :: ReadS [MIDI]
readsPrec :: Int -> ReadS MIDI
$creadsPrec :: Int -> ReadS MIDI
Read)

-- | The basic elements of OSC messages.
data Datum = Int32 {Datum -> Int32
d_int32 :: !Int32}
           | Int64 {Datum -> Int64
d_int64 :: !Int64}
           | Float {Datum -> Float
d_float :: !Float}
           | Double {Datum -> Double
d_double :: !Double}
           | ASCII_String {Datum -> ASCII
d_ascii_string :: !ASCII}
           | Blob {Datum -> BLOB
d_blob :: !BLOB}
           | TimeStamp {Datum -> Double
d_timestamp :: !Time.Time} -- ie. NTPr
           | Midi {Datum -> MIDI
d_midi :: !MIDI}
             deriving (Datum -> Datum -> Bool
(Datum -> Datum -> Bool) -> (Datum -> Datum -> Bool) -> Eq Datum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datum -> Datum -> Bool
$c/= :: Datum -> Datum -> Bool
== :: Datum -> Datum -> Bool
$c== :: Datum -> Datum -> Bool
Eq,ReadPrec [Datum]
ReadPrec Datum
Int -> ReadS Datum
ReadS [Datum]
(Int -> ReadS Datum)
-> ReadS [Datum]
-> ReadPrec Datum
-> ReadPrec [Datum]
-> Read Datum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Datum]
$creadListPrec :: ReadPrec [Datum]
readPrec :: ReadPrec Datum
$creadPrec :: ReadPrec Datum
readList :: ReadS [Datum]
$creadList :: ReadS [Datum]
readsPrec :: Int -> ReadS Datum
$creadsPrec :: Int -> ReadS Datum
Read,Int -> Datum -> ShowS
[Datum] -> ShowS
Datum -> String
(Int -> Datum -> ShowS)
-> (Datum -> String) -> ([Datum] -> ShowS) -> Show Datum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datum] -> ShowS
$cshowList :: [Datum] -> ShowS
show :: Datum -> String
$cshow :: Datum -> String
showsPrec :: Int -> Datum -> ShowS
$cshowsPrec :: Int -> Datum -> ShowS
Show)

-- * Datum types

-- | List of required data types (tag,name).
osc_types_required :: [(Datum_Type,String)]
osc_types_required :: [(Datum_Type, String)]
osc_types_required =
    [(Datum_Type
'i',String
"Int32")
    ,(Datum_Type
'f',String
"Float")
    ,(Datum_Type
's',String
"ASCII_String") -- ASCII
    ,(Datum_Type
'b',String
"ByteArray") -- Blob
    ]

-- | List of optional data types (tag,name).
osc_types_optional :: [(Datum_Type,String)]
osc_types_optional :: [(Datum_Type, String)]
osc_types_optional =
    [(Datum_Type
'h',String
"Int64")
    ,(Datum_Type
't',String
"TimeStamp")
    ,(Datum_Type
'd',String
"Double")
    -- ,('S',"Symbol")
    -- ,('c',"ASCII_Character")
    -- ,('r',"RGBA")
    ,(Datum_Type
'm',String
"MIDI")
    -- ,('T',"True")
    -- ,('F',"False")
    -- ,('N',"Nil")
    -- ,('I',"Infinitum")
    -- ,('[',"Array_Begin")
    -- ,(']',"Array_End")
    ]

-- | List of all data types (tag,name).
osc_types :: [(Datum_Type,String)]
osc_types :: [(Datum_Type, String)]
osc_types = [(Datum_Type, String)]
osc_types_required [(Datum_Type, String)]
-> [(Datum_Type, String)] -> [(Datum_Type, String)]
forall a. [a] -> [a] -> [a]
++ [(Datum_Type, String)]
osc_types_optional

-- | Lookup name of type.
osc_type_name :: Datum_Type -> Maybe String
osc_type_name :: Datum_Type -> Maybe String
osc_type_name Datum_Type
c = Datum_Type -> [(Datum_Type, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Datum_Type
c [(Datum_Type, String)]
osc_types

-- | Erroring variant.
osc_type_name_err :: Datum_Type -> String
osc_type_name_err :: Datum_Type -> String
osc_type_name_err = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ShowS
forall a. HasCallStack => String -> a
error String
"osc_type_name") (Maybe String -> String)
-> (Datum_Type -> Maybe String) -> Datum_Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum_Type -> Maybe String
osc_type_name

-- | Single character identifier of an OSC datum.
datum_tag :: Datum -> Datum_Type
datum_tag :: Datum -> Datum_Type
datum_tag Datum
d =
    case Datum
d of
      Int32 Int32
_ -> Datum_Type
'i'
      Int64 Int64
_ -> Datum_Type
'h'
      Float Float
_ -> Datum_Type
'f'
      Double Double
_ -> Datum_Type
'd'
      ASCII_String ASCII
_ -> Datum_Type
's'
      Blob BLOB
_ -> Datum_Type
'b'
      TimeStamp Double
_ -> Datum_Type
't'
      Midi MIDI
_ -> Datum_Type
'm'

-- | Type and name of 'Datum'.
datum_type_name :: Datum -> (Datum_Type,String)
datum_type_name :: Datum -> (Datum_Type, String)
datum_type_name Datum
d = let c :: Datum_Type
c = Datum -> Datum_Type
datum_tag Datum
d in (Datum_Type
c,Datum_Type -> String
osc_type_name_err Datum_Type
c)

-- * Generalised element access

-- | 'Datum' as 'Integral' if Int32 or Int64.
--
-- > let d = [Int32 5,Int64 5,Float 5.5,Double 5.5]
-- > map datum_integral d == [Just (5::Int),Just 5,Nothing,Nothing]
datum_integral :: Integral i => Datum -> Maybe i
datum_integral :: Datum -> Maybe i
datum_integral Datum
d =
    case Datum
d of
      Int32 Int32
x -> i -> Maybe i
forall a. a -> Maybe a
Just (Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x)
      Int64 Int64
x -> i -> Maybe i
forall a. a -> Maybe a
Just (Int64 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)
      Datum
_ -> Maybe i
forall a. Maybe a
Nothing

-- | 'Datum' as 'Floating' if Int32, Int64, Float, Double or TimeStamp.
--
-- > let d = [Int32 5,Int64 5,Float 5,Double 5,TimeStamp 5]
-- > mapMaybe datum_floating d == replicate 5 (5::Double)
datum_floating :: Floating n => Datum -> Maybe n
datum_floating :: Datum -> Maybe n
datum_floating Datum
d =
    case Datum
d of
      Int32 Int32
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Int32 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
n)
      Int64 Int64
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Int64 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n)
      Float Float
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Float -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
n)
      Double Double
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
      TimeStamp Double
n -> n -> Maybe n
forall a. a -> Maybe a
Just (Double -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n)
      Datum
_ -> Maybe n
forall a. Maybe a
Nothing

-- * Constructors

-- | Type generalised 'Int32'.
--
-- > int32 (1::Int32) == int32 (1::Integer)
-- > d_int32 (int32 (maxBound::Int32)) == maxBound
-- > int32 (((2::Int) ^ (64::Int))::Int) == Int32 0
int32 :: Integral n => n -> Datum
int32 :: n -> Datum
int32 = Int32 -> Datum
Int32 (Int32 -> Datum) -> (n -> Int32) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type generalised Int64.
--
-- > int64 (1::Int32) == int64 (1::Integer)
-- > d_int64 (int64 (maxBound::Int64)) == maxBound
int64 :: Integral n => n -> Datum
int64 :: n -> Datum
int64 = Int64 -> Datum
Int64 (Int64 -> Datum) -> (n -> Int64) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Type generalised Float.
--
-- > float (1::Int) == float (1::Double)
-- > floatRange (undefined::Float) == (-125,128)
-- > isInfinite (d_float (float (encodeFloat 1 256 :: Double))) == True
float :: Real n => n -> Datum
float :: n -> Datum
float = Float -> Datum
Float (Float -> Datum) -> (n -> Float) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Type generalised Double.
--
-- > double (1::Int) == double (1::Double)
-- > double (encodeFloat 1 256 :: Double) == Double 1.157920892373162e77
double :: Real n => n -> Datum
double :: n -> Datum
double = Double -> Datum
Double (Double -> Datum) -> (n -> Double) -> n -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | 'ASCII_String' of 'Char8.pack'.
--
-- > string "string" == ASCII_String (Char8.pack "string")
string :: String -> Datum
string :: String -> Datum
string = ASCII -> Datum
ASCII_String (ASCII -> Datum) -> (String -> ASCII) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ASCII
Char8.pack

-- | Four-tuple variant of 'Midi' '.' 'MIDI'.
--
-- > midi (0,0,0,0) == Midi (MIDI 0 0 0 0)
midi :: (Word8,Word8,Word8,Word8) -> Datum
midi :: (Word8, Word8, Word8, Word8) -> Datum
midi (Word8
p,Word8
q,Word8
r,Word8
s) = MIDI -> Datum
Midi (Word8 -> Word8 -> Word8 -> Word8 -> MIDI
MIDI Word8
p Word8
q Word8
r Word8
s)

-- | 'Blob' of 'blob_pack'.
blob :: [Word8] -> Datum
blob :: [Word8] -> Datum
blob = BLOB -> Datum
Blob (BLOB -> Datum) -> ([Word8] -> BLOB) -> [Word8] -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BLOB
blob_pack

-- * Descriptor

-- | Message argument types are given by a descriptor.
--
-- > descriptor [Int32 1,Float 1,string "1"] == ascii ",ifs"
descriptor :: [Datum] -> ASCII
descriptor :: [Datum] -> ASCII
descriptor [Datum]
l = String -> ASCII
Char8.pack (Datum_Type
',' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: (Datum -> Datum_Type) -> [Datum] -> String
forall a b. (a -> b) -> [a] -> [b]
map Datum -> Datum_Type
datum_tag [Datum]
l)

-- | Descriptor tags are @comma@ prefixed.
descriptor_tags :: ASCII -> ASCII
descriptor_tags :: ASCII -> ASCII
descriptor_tags = Int -> ASCII -> ASCII
Char8.drop Int
1

-- * Pretty printing

-- | Perhaps a precision value for floating point numbers.
type FP_Precision = Maybe Int

-- | Variant of 'showFFloat' that deletes trailing zeros.
--
-- > map (floatPP (Just 4)) [1,pi] == ["1.0","3.1416"]
floatPP :: RealFloat n => FP_Precision -> n -> String
floatPP :: FP_Precision -> n -> String
floatPP FP_Precision
p n
n =
    let s :: String
s = FP_Precision -> n -> ShowS
forall a. RealFloat a => FP_Precision -> a -> ShowS
showFFloat FP_Precision
p n
n String
""
        s' :: String
s' = (Datum_Type -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Datum_Type -> Datum_Type -> Bool
forall a. Eq a => a -> a -> Bool
== Datum_Type
'0') (ShowS
forall a. [a] -> [a]
reverse String
s)
    in case String
s' of
         Datum_Type
'.':String
_ -> ShowS
forall a. [a] -> [a]
reverse (Datum_Type
'0' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: String
s')
         String
_ -> ShowS
forall a. [a] -> [a]
reverse String
s'

-- | Pretty printer for 'Time'.
--
-- > timePP (Just 4) (1/3) == "0.3333"
timePP :: FP_Precision -> Time.Time -> String
timePP :: FP_Precision -> Double -> String
timePP = FP_Precision -> Double -> String
forall n. RealFloat n => FP_Precision -> n -> String
floatPP

-- | Pretty printer for vectors.
--
-- > vecPP show [1::Int,2,3] == "<1,2,3>"
vecPP :: (a -> String) -> [a] -> String
vecPP :: (a -> String) -> [a] -> String
vecPP a -> String
f [a]
v = Datum_Type
'<' Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Pretty printer for blobs, two-digit zero-padded hexadecimal.
blobPP :: BLOB -> String
blobPP :: BLOB -> String
blobPP = (Datum_Type
'B'Datum_Type -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (BLOB -> String) -> BLOB -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> String) -> [Word8] -> String
forall a. (a -> String) -> [a] -> String
vecPP (String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02X") ([Word8] -> String) -> (BLOB -> [Word8]) -> BLOB -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BLOB -> [Word8]
Lazy.unpack

-- | Print strings in double quotes iff they contain white space.
stringPP :: String -> String
stringPP :: ShowS
stringPP String
x = if (Datum_Type -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Datum_Type -> Bool
isSpace String
x then ShowS
forall a. Show a => a -> String
show String
x else String
x

{- | Pretty printer for 'Datum'.

> let d = [Int32 1,Float 1.2,string "str",midi (0,0x90,0x40,0x60),blob [12,16]]
> map (datumPP (Just 5)) d==  ["1","1.2","str","M<0,144,64,96>","B<0C,10>"]

-}
datumPP :: FP_Precision -> Datum -> String
datumPP :: FP_Precision -> Datum -> String
datumPP FP_Precision
p Datum
d =
    case Datum
d of
      Int32 Int32
n -> Int32 -> String
forall a. Show a => a -> String
show Int32
n
      Int64 Int64
n -> Int64 -> String
forall a. Show a => a -> String
show Int64
n
      Float Float
n -> FP_Precision -> Float -> String
forall n. RealFloat n => FP_Precision -> n -> String
floatPP FP_Precision
p Float
n
      Double Double
n -> FP_Precision -> Double -> String
forall n. RealFloat n => FP_Precision -> n -> String
floatPP FP_Precision
p Double
n
      ASCII_String ASCII
s -> ShowS
stringPP (ASCII -> String
Char8.unpack ASCII
s)
      Blob BLOB
s -> BLOB -> String
blobPP BLOB
s
      TimeStamp Double
t -> FP_Precision -> Double -> String
timePP FP_Precision
p Double
t
      Midi (MIDI Word8
b1 Word8
b2 Word8
b3 Word8
b4) -> Datum_Type
'M'Datum_Type -> ShowS
forall a. a -> [a] -> [a]
: (Word8 -> String) -> [Word8] -> String
forall a. (a -> String) -> [a] -> String
vecPP Word8 -> String
forall a. Show a => a -> String
show [Word8
b1,Word8
b2,Word8
b3,Word8
b4]

-- | Variant of 'datumPP' that appends the 'datum_type_name'.
datum_pp_typed :: FP_Precision -> Datum -> String
datum_pp_typed :: FP_Precision -> Datum -> String
datum_pp_typed FP_Precision
fp Datum
d = FP_Precision -> Datum -> String
datumPP FP_Precision
fp Datum
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Datum_Type, String) -> String
forall a b. (a, b) -> b
snd (Datum -> (Datum_Type, String)
datum_type_name Datum
d)

-- * Parser

-- | Given 'Datum_Type' attempt to parse 'Datum' at 'String'.
--
-- > parse_datum 'i' "42" == Just (Int32 42)
-- > parse_datum 'h' "42" == Just (Int64 42)
-- > parse_datum 'f' "3.14159" == Just (Float 3.14159)
-- > parse_datum 'd' "3.14159" == Just (Double 3.14159)
-- > parse_datum 's' "\"pi\"" == Just (string "pi")
-- > parse_datum 'b' "[112,105]" == Just (Blob (blob_pack [112,105]))
-- > parse_datum 'm' "(0,144,60,90)" == Just (midi (0,144,60,90))
parse_datum :: Datum_Type -> String -> Maybe Datum
parse_datum :: Datum_Type -> String -> Maybe Datum
parse_datum Datum_Type
ty =
    case Datum_Type
ty of
      Datum_Type
'i' -> (Int32 -> Datum) -> Maybe Int32 -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Datum
Int32 (Maybe Int32 -> Maybe Datum)
-> (String -> Maybe Int32) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int32
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
'h' -> (Int64 -> Datum) -> Maybe Int64 -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Datum
Int64 (Maybe Int64 -> Maybe Datum)
-> (String -> Maybe Int64) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int64
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
'f' -> (Float -> Datum) -> Maybe Float -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Datum
Float (Maybe Float -> Maybe Datum)
-> (String -> Maybe Float) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
'd' -> (Double -> Datum) -> Maybe Double -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Datum
Double (Maybe Double -> Maybe Datum)
-> (String -> Maybe Double) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
's' -> (String -> Datum) -> Maybe String -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASCII -> Datum
ASCII_String (ASCII -> Datum) -> (String -> ASCII) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ASCII
Char8.pack) (Maybe String -> Maybe Datum)
-> (String -> Maybe String) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
'b' -> ([Word8] -> Datum) -> Maybe [Word8] -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BLOB -> Datum
Blob (BLOB -> Datum) -> ([Word8] -> BLOB) -> [Word8] -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BLOB
blob_pack) (Maybe [Word8] -> Maybe Datum)
-> (String -> Maybe [Word8]) -> String -> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe [Word8]
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
't' -> String -> String -> Maybe Datum
forall a. HasCallStack => String -> a
error String
"parse_datum: timestamp not implemented"
      Datum_Type
'm' -> ((Word8, Word8, Word8, Word8) -> Datum)
-> Maybe (Word8, Word8, Word8, Word8) -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8, Word8, Word8, Word8) -> Datum
midi (Maybe (Word8, Word8, Word8, Word8) -> Maybe Datum)
-> (String -> Maybe (Word8, Word8, Word8, Word8))
-> String
-> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Word8, Word8, Word8, Word8)
forall a. Read a => String -> Maybe a
readMaybe
      Datum_Type
_ -> String -> String -> Maybe Datum
forall a. HasCallStack => String -> a
error String
"parse_datum: unknown type"

-- | Erroring variant of 'parse_datum'.
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err :: Datum_Type -> String -> Datum
parse_datum_err Datum_Type
ty = Datum -> Maybe Datum -> Datum
forall a. a -> Maybe a -> a
fromMaybe (String -> Datum
forall a. HasCallStack => String -> a
error String
"parse_datum") (Maybe Datum -> Datum)
-> (String -> Maybe Datum) -> String -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum_Type -> String -> Maybe Datum
parse_datum Datum_Type
ty