module Sound.Tidal.Stream.Types where

import Control.Concurrent.MVar
import qualified Data.Map.Strict as Map
import qualified Network.Socket as N
import qualified Sound.Osc.Transport.Fd.Udp as O
import qualified Sound.Tidal.Clock as Clock
import Sound.Tidal.Config
import Sound.Tidal.Pattern
import Sound.Tidal.Show ()

data Stream = Stream
  { Stream -> Config
sConfig :: Config,
    Stream -> MVar ValueMap
sStateMV :: MVar ValueMap,
    -- sOutput :: MVar ControlPattern,
    Stream -> ClockRef
sClockRef :: Clock.ClockRef,
    Stream -> Maybe Udp
sListen :: Maybe O.Udp,
    Stream -> MVar PlayMap
sPMapMV :: MVar PlayMap,
    Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV :: MVar (ControlPattern -> ControlPattern),
    Stream -> [Cx]
sCxs :: [Cx]
  }

data Cx = Cx
  { Cx -> Target
cxTarget :: Target,
    Cx -> Udp
cxUDP :: O.Udp,
    Cx -> [OSC]
cxOSCs :: [OSC],
    Cx -> AddrInfo
cxAddr :: N.AddrInfo,
    Cx -> Maybe AddrInfo
cxBusAddr :: Maybe N.AddrInfo,
    Cx -> Maybe (MVar [Int])
cxBusses :: Maybe (MVar [Int])
  }

data StampStyle
  = BundleStamp
  | MessageStamp
  deriving (StampStyle -> StampStyle -> Bool
(StampStyle -> StampStyle -> Bool)
-> (StampStyle -> StampStyle -> Bool) -> Eq StampStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StampStyle -> StampStyle -> Bool
== :: StampStyle -> StampStyle -> Bool
$c/= :: StampStyle -> StampStyle -> Bool
/= :: StampStyle -> StampStyle -> Bool
Eq, Int -> StampStyle -> ShowS
[StampStyle] -> ShowS
StampStyle -> String
(Int -> StampStyle -> ShowS)
-> (StampStyle -> String)
-> ([StampStyle] -> ShowS)
-> Show StampStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StampStyle -> ShowS
showsPrec :: Int -> StampStyle -> ShowS
$cshow :: StampStyle -> String
show :: StampStyle -> String
$cshowList :: [StampStyle] -> ShowS
showList :: [StampStyle] -> ShowS
Show)

data Schedule
  = Pre StampStyle
  | Live
  deriving (Schedule -> Schedule -> Bool
(Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool) -> Eq Schedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
/= :: Schedule -> Schedule -> Bool
Eq, Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> String
(Int -> Schedule -> ShowS)
-> (Schedule -> String) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Schedule -> ShowS
showsPrec :: Int -> Schedule -> ShowS
$cshow :: Schedule -> String
show :: Schedule -> String
$cshowList :: [Schedule] -> ShowS
showList :: [Schedule] -> ShowS
Show)

data Target = Target
  { Target -> String
oName :: String,
    Target -> String
oAddress :: String,
    Target -> Int
oPort :: Int,
    Target -> Maybe Int
oBusPort :: Maybe Int,
    Target -> Double
oLatency :: Double,
    Target -> Maybe Arc
oWindow :: Maybe Arc,
    Target -> Schedule
oSchedule :: Schedule,
    Target -> Bool
oHandshake :: Bool
  }
  deriving (Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
Show)

data Args
  = Named {Args -> [String]
requiredArgs :: [String]}
  | ArgList [(String, Maybe Value)]
  deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> String
show :: Args -> String
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show)

data OSC
  = OSC
      { OSC -> String
path :: String,
        OSC -> Args
args :: Args
      }
  | OSCContext {path :: String}
  deriving (Int -> OSC -> ShowS
[OSC] -> ShowS
OSC -> String
(Int -> OSC -> ShowS)
-> (OSC -> String) -> ([OSC] -> ShowS) -> Show OSC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OSC -> ShowS
showsPrec :: Int -> OSC -> ShowS
$cshow :: OSC -> String
show :: OSC -> String
$cshowList :: [OSC] -> ShowS
showList :: [OSC] -> ShowS
Show)

data PlayState = PlayState
  { PlayState -> ControlPattern
psPattern :: ControlPattern,
    PlayState -> Bool
psMute :: Bool,
    PlayState -> Bool
psSolo :: Bool,
    PlayState -> [ControlPattern]
psHistory :: [ControlPattern]
  }
  deriving (Int -> PlayState -> ShowS
[PlayState] -> ShowS
PlayState -> String
(Int -> PlayState -> ShowS)
-> (PlayState -> String)
-> ([PlayState] -> ShowS)
-> Show PlayState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlayState -> ShowS
showsPrec :: Int -> PlayState -> ShowS
$cshow :: PlayState -> String
show :: PlayState -> String
$cshowList :: [PlayState] -> ShowS
showList :: [PlayState] -> ShowS
Show)

type PatId = String

type PlayMap = Map.Map PatId PlayState

-- data TickState = TickState {
--                     tickArc   :: Arc,
--                     tickNudge :: Double
--                    }
--   deriving Show