{-# OPTIONS_GHC -fno-warn-dodgy-imports -fno-warn-name-shadowing #-}
module Sound.Tidal.Carabiner where

{-
    Carabiner.hs - For syncing with the Link protocol over Carabiner.
    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/>.
-}

import Network.Socket hiding (send, sendTo, recv, recvFrom)
import Network.Socket.ByteString (send, recv)
import qualified Data.ByteString.Char8 as B8
import Control.Concurrent (forkIO, takeMVar, putMVar)
import qualified Sound.Tidal.Stream as S
import Sound.Tidal.Tempo
import System.Clock
import Text.Read (readMaybe)
import Control.Monad (when, forever)
import Data.Maybe (isJust, fromJust)
import qualified Sound.OSC.FD as O

carabiner :: S.Stream -> Int -> Double -> IO Socket
carabiner :: Stream -> Int -> Double -> IO Socket
carabiner Stream
tidal Int
bpc Double
latency = do Socket
sock <- Stream -> Int -> Double -> String -> Int -> IO Socket
client Stream
tidal Int
bpc Double
latency String
"127.0.0.1" Int
17000
                                 Socket -> String -> IO ()
sendMsg Socket
sock String
"status\n"
                                 Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

client :: S.Stream -> Int -> Double -> String -> Int -> IO Socket
client :: Stream -> Int -> Double -> String -> Int -> IO Socket
client Stream
tidal Int
bpc Double
latency String
host Int
port = IO Socket -> IO Socket
forall a. IO a -> IO a
withSocketsDo (IO Socket -> IO Socket) -> IO Socket -> IO Socket
forall a b. (a -> b) -> a -> b
$
                       do [AddrInfo]
addrInfo <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (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)
                          let serverAddr :: AddrInfo
serverAddr = [AddrInfo] -> AddrInfo
forall a. [a] -> a
head [AddrInfo]
addrInfo
                          Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
serverAddr) SocketType
Stream ProtocolNumber
defaultProtocol
                          Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
serverAddr)
                          ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Stream -> Int -> Double -> Socket -> IO ()
listener Stream
tidal Int
bpc Double
latency Socket
sock
                          -- sendMsg sock "status\n"
                          -- threadDelay 10000000
                          Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

listener :: S.Stream -> Int -> Double -> Socket -> IO ()
listener :: Stream -> Int -> Double -> Socket -> IO ()
listener Stream
tidal Int
bpc Double
latency Socket
sock =
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do ByteString
rMsg <- Socket -> Int -> IO ByteString
recv Socket
sock Int
1024
               let msg :: String
msg = ByteString -> String
B8.unpack ByteString
rMsg
                   (String
name:String
_:[String]
ws) = String -> [String]
words String
msg
                   pairs :: [(String, String)]
pairs = [String] -> [(String, String)]
forall b. [b] -> [(b, b)]
pairs' [String]
ws
                   pairs' :: [b] -> [(b, b)]
pairs' (b
a:b
b:[b]
xs) = (b
a,b
b)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:([b] -> [(b, b)]
pairs' [b]
xs)
                   pairs' [b]
_ = []
               Stream -> Int -> Double -> String -> [(String, String)] -> IO ()
act Stream
tidal Int
bpc Double
latency String
name [(String, String)]
pairs

act :: S.Stream -> Int -> Double -> String -> [(String, String)] -> IO ()
act :: Stream -> Int -> Double -> String -> [(String, String)] -> IO ()
act Stream
tidal Int
bpc Double
latency String
"status" [(String, String)]
pairs
  = do let start :: Maybe Integer
start = (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
":start" [(String, String)]
pairs Maybe String -> (String -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe) :: Maybe Integer
           bpm :: Maybe Double
bpm   = (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
":bpm"   [(String, String)]
pairs Maybe String -> (String -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe) :: Maybe Double
           beat :: Maybe Double
beat  = (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
":beat"  [(String, String)]
pairs Maybe String -> (String -> Maybe Double) -> Maybe Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe) :: Maybe Double
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust Maybe Integer
start, Maybe Double -> Bool
forall a. Maybe a -> Bool
isJust Maybe Double
bpm, Maybe Double -> Bool
forall a. Maybe a -> Bool
isJust Maybe Double
beat]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
         TimeSpec
nowM <- Clock -> IO TimeSpec
getTime Clock
Monotonic
         Double
nowO <- IO Double
forall (m :: * -> *). MonadIO m => m Double
O.time
         let m :: Double
m = (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
sec TimeSpec
nowM) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ((Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
nsec TimeSpec
nowM)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1000000000)
             d :: Double
d = Double
nowO Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m
             start' :: Double
start' = ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
start) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000000)
             startO :: Double
startO = Double
start' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
d
             -- cyc = toRational $ (fromJust beat) / (fromIntegral bpc)
         Tempo
tempo <- MVar Tempo -> IO Tempo
forall a. MVar a -> IO a
takeMVar (Stream -> MVar Tempo
S.sTempoMV Stream
tidal)
         let tempo' :: Tempo
tempo' = Tempo
tempo {atTime :: Double
atTime = Double
startO Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
latency,
                             atCycle :: Rational
atCycle = Rational
0,
                             cps :: Double
cps = ((Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Double
bpm) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
60) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bpc)
                            }
         MVar Tempo -> Tempo -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar Tempo
S.sTempoMV Stream
tidal) (Tempo -> IO ()) -> Tempo -> IO ()
forall a b. (a -> b) -> a -> b
$ Tempo
tempo'
act Stream
_ Int
_ Double
_ String
name [(String, String)]
_ = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unhandled thingie " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name

sendMsg :: Socket -> String -> IO ()
sendMsg :: Socket -> String -> IO ()
sendMsg Socket
sock String
msg = do Int
_ <- Socket -> ByteString -> IO Int
send Socket
sock (ByteString -> IO Int) -> ByteString -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B8.pack String
msg
                      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()