module Sound.Tidal.Stream.Target where

import Control.Concurrent
  ( forkIO,
    forkOS,
    newMVar,
    readMVar,
    swapMVar,
    threadDelay,
  )
import Control.Monad (when)
import Data.Maybe (catMaybes, fromJust, isJust)
import Foreign (Word8)
import qualified Network.Socket as N
import qualified Sound.Osc.Fd as O
import qualified Sound.Osc.Time.Timeout as O
import qualified Sound.Osc.Transport.Fd.Udp as O
import Sound.Tidal.Config
import Sound.Tidal.Pattern
import Sound.Tidal.Stream.Types

{-
    Target.hs - Create and send to OSC targets
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

getCXs :: Config -> [(Target, [OSC])] -> IO [Cx]
getCXs :: Config -> [(Target, [OSC])] -> IO [Cx]
getCXs Config
config [(Target, [OSC])]
oscmap =
  ((Target, [OSC]) -> IO Cx) -> [(Target, [OSC])] -> IO [Cx]
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
    ( \(Target
target, [OSC]
os) -> do
        AddrInfo
remote_addr <- String -> Int -> IO AddrInfo
resolve (Target -> String
oAddress Target
target) (Target -> Int
oPort Target
target)
        Maybe AddrInfo
remote_bus_addr <- (Int -> IO AddrInfo) -> Maybe Int -> IO (Maybe AddrInfo)
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) -> Maybe a -> m (Maybe b)
mapM (String -> Int -> IO AddrInfo
resolve (Target -> String
oAddress Target
target)) (Target -> Maybe Int
oBusPort Target
target)
        Maybe (MVar [Int])
remote_busses <- Maybe (IO (MVar [Int])) -> IO (Maybe (MVar [Int]))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence (Target -> Maybe Int
oBusPort Target
target Maybe Int -> Maybe (IO (MVar [Int])) -> Maybe (IO (MVar [Int]))
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (MVar [Int]) -> Maybe (IO (MVar [Int]))
forall a. a -> Maybe a
Just ([Int] -> IO (MVar [Int])
forall a. a -> IO (MVar a)
newMVar []))

        let broadcast :: Int
broadcast = if Config -> Bool
cCtrlBroadcast Config
config then Int
1 else Int
0
        Udp
u <-
          (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp
O.udp_socket
            (\Socket
sock SockAddr
_ -> do Socket -> SocketOption -> Int -> IO ()
N.setSocketOption Socket
sock SocketOption
N.Broadcast Int
broadcast)
            (Target -> String
oAddress Target
target)
            (Target -> Int
oPort Target
target)
        let cx :: Cx
cx = Cx {cxUDP :: Udp
cxUDP = Udp
u, cxAddr :: AddrInfo
cxAddr = AddrInfo
remote_addr, cxBusAddr :: Maybe AddrInfo
cxBusAddr = Maybe AddrInfo
remote_bus_addr, cxBusses :: Maybe (MVar [Int])
cxBusses = Maybe (MVar [Int])
remote_busses, cxTarget :: Target
cxTarget = Target
target, cxOSCs :: [OSC]
cxOSCs = [OSC]
os}
        ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Cx -> Config -> IO ()
handshake Cx
cx Config
config
        Cx -> IO Cx
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cx
cx
    )
    [(Target, [OSC])]
oscmap

resolve :: String -> Int -> IO N.AddrInfo
resolve :: String -> Int -> IO AddrInfo
resolve String
host Int
port = do
  let hints :: AddrInfo
hints = AddrInfo
N.defaultHints {N.addrSocketType = N.Stream}
  AddrInfo
addr : [AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
N.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
  AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
addr

handshake :: Cx -> Config -> IO ()
handshake :: Cx -> Config -> IO ()
handshake Cx {cxUDP :: Cx -> Udp
cxUDP = Udp
udp, cxBusses :: Cx -> Maybe (MVar [Int])
cxBusses = Just MVar [Int]
bussesMV, cxAddr :: Cx -> AddrInfo
cxAddr = AddrInfo
addr} Config
c = IO ()
sendHandshake IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
listen Int
0
  where
    sendHandshake :: IO ()
    sendHandshake :: IO ()
sendHandshake = Udp -> PacketOf Message -> SockAddr -> IO ()
O.sendTo Udp
udp (Message -> PacketOf Message
forall t. Message -> PacketOf t
O.Packet_Message (Message -> PacketOf Message) -> Message -> PacketOf Message
forall a b. (a -> b) -> a -> b
$ String -> [Datum] -> Message
O.Message String
"/dirt/handshake" []) (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)
    listen :: Int -> IO ()
    listen :: Int -> IO ()
listen Int
waits = do
      [Message]
ms <- Double -> Udp -> IO [Message]
forall t. Transport t => Double -> t -> IO [Message]
recvMessagesTimeout Double
2 Udp
udp
      if [Message] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message]
ms
        then do
          Int -> IO ()
checkHandshake Int
waits -- there was a timeout, check handshake
          Int -> IO ()
listen (Int
waits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        else do
          (Message -> IO ()) -> [Message] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Message -> IO ()
respond [Message]
ms
          Int -> IO ()
listen Int
0
    checkHandshake :: Int -> IO ()
    checkHandshake :: Int -> IO ()
checkHandshake Int
waits = do
      [Int]
busses <- MVar [Int] -> IO [Int]
forall a. MVar a -> IO a
readMVar MVar [Int]
bussesMV
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
busses) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
waits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> String -> IO ()
verbose Config
c (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Waiting for SuperDirt (v.1.7.2 or higher).."
        IO ()
sendHandshake
    respond :: O.Message -> IO ()
    respond :: Message -> IO ()
respond (O.Message String
"/dirt/hello" [Datum]
_) = IO ()
sendHandshake
    respond (O.Message String
"/dirt/handshake/reply" [Datum]
xs) = do
      [Int]
prev <- MVar [Int] -> [Int] -> IO [Int]
forall a. MVar a -> a -> IO a
swapMVar MVar [Int]
bussesMV ([Int] -> IO [Int]) -> [Int] -> IO [Int]
forall a b. (a -> b) -> a -> b
$ [Datum] -> [Int]
bufferIndices [Datum]
xs
      -- Only report the first time..
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
prev) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> String -> IO ()
verbose Config
c (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Connected to SuperDirt."
    respond Message
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    bufferIndices :: [O.Datum] -> [Int]
    bufferIndices :: [Datum] -> [Int]
bufferIndices [] = []
    bufferIndices (Datum
x : [Datum]
xs')
      | Datum
x Datum -> Datum -> Bool
forall a. Eq a => a -> a -> Bool
== Ascii -> Datum
O.AsciiString (String -> Ascii
O.ascii String
"&controlBusIndices") = [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> [Int]) -> [Maybe Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Bool) -> [Maybe Int] -> [Maybe Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe Int] -> [Maybe Int]) -> [Maybe Int] -> [Maybe Int]
forall a b. (a -> b) -> a -> b
$ (Datum -> Maybe Int) -> [Datum] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Datum -> Maybe Int
forall i. Integral i => Datum -> Maybe i
O.datum_integral [Datum]
xs'
      | Bool
otherwise = [Datum] -> [Int]
bufferIndices [Datum]
xs'
handshake Cx
_ Config
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

recvMessagesTimeout :: (O.Transport t) => Double -> t -> IO [O.Message]
recvMessagesTimeout :: forall t. Transport t => Double -> t -> IO [Message]
recvMessagesTimeout Double
n t
sock = (Maybe (PacketOf Message) -> [Message])
-> IO (Maybe (PacketOf Message)) -> IO [Message]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Message]
-> (PacketOf Message -> [Message])
-> Maybe (PacketOf Message)
-> [Message]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] PacketOf Message -> [Message]
O.packetMessages) (IO (Maybe (PacketOf Message)) -> IO [Message])
-> IO (Maybe (PacketOf Message)) -> IO [Message]
forall a b. (a -> b) -> a -> b
$ Double -> t -> IO (Maybe (PacketOf Message))
forall t.
Transport t =>
Double -> t -> IO (Maybe (PacketOf Message))
O.recvPacketTimeout Double
n t
sock

-- send has three modes:
-- Send events early using timestamp in the OSC bundle - used by Superdirt
-- Send events early by adding timestamp to the OSC message - used by Dirt
-- Send events live by delaying the thread
send :: Cx -> Double -> Double -> (Double, Bool, O.Message) -> IO ()
send :: Cx -> Double -> Double -> (Double, Bool, Message) -> IO ()
send Cx
cx Double
latency Double
extraLatency (Double
time, Bool
isBusMsg, Message
m)
  | Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
BundleStamp = Bool -> Cx -> Bundle -> IO ()
sendBndl Bool
isBusMsg Cx
cx (Bundle -> IO ()) -> Bundle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> [Message] -> Bundle
forall t. Double -> [t] -> BundleOf t
O.Bundle Double
timeWithLatency [Message
m]
  | Target -> Schedule
oSchedule Target
target Schedule -> Schedule -> Bool
forall a. Eq a => a -> a -> Bool
== StampStyle -> Schedule
Pre StampStyle
MessageStamp = Bool -> Cx -> Message -> IO ()
sendO Bool
isBusMsg Cx
cx (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$ Message -> Message
addtime Message
m
  | Bool
otherwise = do
      ThreadId
_ <- IO () -> IO ThreadId
forkOS (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        Double
now <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
        Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
timeWithLatency Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
now) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000000
        Bool -> Cx -> Message -> IO ()
sendO Bool
isBusMsg Cx
cx Message
m
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    addtime :: Message -> Message
addtime (O.Message String
mpath [Datum]
params) = String -> [Datum] -> Message
O.Message String
mpath ((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
sec) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: ((Int -> Datum
forall n. Integral n => n -> Datum
O.int32 Int
usec) Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
params))
    ut :: Double
ut = Double -> Double
forall n. Num n => n -> n
O.ntpr_to_posix Double
timeWithLatency
    sec :: Int
    sec :: Int
sec = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ut
    usec :: Int
    usec :: Int
usec = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
1000000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
ut Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec))
    target :: Target
target = Cx -> Target
cxTarget Cx
cx
    timeWithLatency :: Double
timeWithLatency = Double
time Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
latency Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
extraLatency

sendBndl :: Bool -> Cx -> O.Bundle -> IO ()
sendBndl :: Bool -> Cx -> Bundle -> IO ()
sendBndl Bool
isBusMsg Cx
cx Bundle
bndl = Udp -> PacketOf Message -> SockAddr -> IO ()
O.sendTo (Cx -> Udp
cxUDP Cx
cx) (Bundle -> PacketOf Message
forall t. BundleOf t -> PacketOf t
O.Packet_Bundle Bundle
bndl) (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)
  where
    addr :: AddrInfo
addr
      | Bool
isBusMsg Bool -> Bool -> Bool
&& Maybe AddrInfo -> Bool
forall a. Maybe a -> Bool
isJust (Cx -> Maybe AddrInfo
cxBusAddr Cx
cx) = Maybe AddrInfo -> AddrInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AddrInfo -> AddrInfo) -> Maybe AddrInfo -> AddrInfo
forall a b. (a -> b) -> a -> b
$ Cx -> Maybe AddrInfo
cxBusAddr Cx
cx
      | Bool
otherwise = Cx -> AddrInfo
cxAddr Cx
cx

sendO :: Bool -> Cx -> O.Message -> IO ()
sendO :: Bool -> Cx -> Message -> IO ()
sendO Bool
isBusMsg Cx
cx Message
msg = Udp -> PacketOf Message -> SockAddr -> IO ()
O.sendTo (Cx -> Udp
cxUDP Cx
cx) (Message -> PacketOf Message
forall t. Message -> PacketOf t
O.Packet_Message Message
msg) (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)
  where
    addr :: AddrInfo
addr
      | Bool
isBusMsg Bool -> Bool -> Bool
&& Maybe AddrInfo -> Bool
forall a. Maybe a -> Bool
isJust (Cx -> Maybe AddrInfo
cxBusAddr Cx
cx) = Maybe AddrInfo -> AddrInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AddrInfo -> AddrInfo) -> Maybe AddrInfo -> AddrInfo
forall a b. (a -> b) -> a -> b
$ Cx -> Maybe AddrInfo
cxBusAddr Cx
cx
      | Bool
otherwise = Cx -> AddrInfo
cxAddr Cx
cx

superdirtTarget :: Target
superdirtTarget :: Target
superdirtTarget =
  Target
    { oName :: String
oName = String
"SuperDirt",
      oAddress :: String
oAddress = String
"127.0.0.1",
      oPort :: Int
oPort = Int
57120,
      oBusPort :: Maybe Int
oBusPort = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
57110,
      oLatency :: Double
oLatency = Double
0.2,
      oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
      oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
BundleStamp,
      oHandshake :: Bool
oHandshake = Bool
True
    }

superdirtShape :: OSC
superdirtShape :: OSC
superdirtShape = String -> Args -> OSC
OSC String
"/dirt/play" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$ Named {requiredArgs :: [String]
requiredArgs = [String
"s"]}

dirtTarget :: Target
dirtTarget :: Target
dirtTarget =
  Target
    { oName :: String
oName = String
"Dirt",
      oAddress :: String
oAddress = String
"127.0.0.1",
      oPort :: Int
oPort = Int
7771,
      oBusPort :: Maybe Int
oBusPort = Maybe Int
forall a. Maybe a
Nothing,
      oLatency :: Double
oLatency = Double
0.02,
      oWindow :: Maybe Arc
oWindow = Maybe Arc
forall a. Maybe a
Nothing,
      oSchedule :: Schedule
oSchedule = StampStyle -> Schedule
Pre StampStyle
MessageStamp,
      oHandshake :: Bool
oHandshake = Bool
False
    }

dirtShape :: OSC
dirtShape :: OSC
dirtShape =
  String -> Args -> OSC
OSC String
"/play" (Args -> OSC) -> Args -> OSC
forall a b. (a -> b) -> a -> b
$
    [(String, Maybe Value)] -> Args
ArgList
      [ (String
"cps", Double -> Maybe Value
fDefault Double
0),
        (String
"s", Maybe Value
forall a. Maybe a
Nothing),
        (String
"offset", Double -> Maybe Value
fDefault Double
0),
        (String
"begin", Double -> Maybe Value
fDefault Double
0),
        (String
"end", Double -> Maybe Value
fDefault Double
1),
        (String
"speed", Double -> Maybe Value
fDefault Double
1),
        (String
"pan", Double -> Maybe Value
fDefault Double
0.5),
        (String
"velocity", Double -> Maybe Value
fDefault Double
0.5),
        (String
"vowel", String -> Maybe Value
sDefault String
""),
        (String
"cutoff", Double -> Maybe Value
fDefault Double
0),
        (String
"resonance", Double -> Maybe Value
fDefault Double
0),
        (String
"accelerate", Double -> Maybe Value
fDefault Double
0),
        (String
"shape", Double -> Maybe Value
fDefault Double
0),
        (String
"kriole", Int -> Maybe Value
iDefault Int
0),
        (String
"gain", Double -> Maybe Value
fDefault Double
1),
        (String
"cut", Int -> Maybe Value
iDefault Int
0),
        (String
"delay", Double -> Maybe Value
fDefault Double
0),
        (String
"delaytime", Double -> Maybe Value
fDefault (-Double
1)),
        (String
"delayfeedback", Double -> Maybe Value
fDefault (-Double
1)),
        (String
"crush", Double -> Maybe Value
fDefault Double
0),
        (String
"coarse", Int -> Maybe Value
iDefault Int
0),
        (String
"hcutoff", Double -> Maybe Value
fDefault Double
0),
        (String
"hresonance", Double -> Maybe Value
fDefault Double
0),
        (String
"bandf", Double -> Maybe Value
fDefault Double
0),
        (String
"bandq", Double -> Maybe Value
fDefault Double
0),
        (String
"unit", String -> Maybe Value
sDefault String
"rate"),
        (String
"loop", Double -> Maybe Value
fDefault Double
0),
        (String
"n", Double -> Maybe Value
fDefault Double
0),
        (String
"attack", Double -> Maybe Value
fDefault (-Double
1)),
        (String
"hold", Double -> Maybe Value
fDefault Double
0),
        (String
"release", Double -> Maybe Value
fDefault (-Double
1)),
        (String
"orbit", Int -> Maybe Value
iDefault Int
0) -- ,
        -- ("id", iDefault 0)
      ]

sDefault :: String -> Maybe Value
sDefault :: String -> Maybe Value
sDefault String
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ String -> Value
VS String
x

fDefault :: Double -> Maybe Value
fDefault :: Double -> Maybe Value
fDefault Double
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF Double
x

rDefault :: Rational -> Maybe Value
rDefault :: Rational -> Maybe Value
rDefault Rational
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Rational -> Value
VR Rational
x

iDefault :: Int -> Maybe Value
iDefault :: Int -> Maybe Value
iDefault Int
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI Int
x

bDefault :: Bool -> Maybe Value
bDefault :: Bool -> Maybe Value
bDefault Bool
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
VB Bool
x

xDefault :: [Word8] -> Maybe Value
xDefault :: [Word8] -> Maybe Value
xDefault [Word8]
x = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Word8] -> Value
VX [Word8]
x