-- | Trivial UDP server functions.
module Sound.OSC.Transport.JSON where

import Control.Monad.IO.Class {- transformers -}
import qualified Data.ByteString as B {- bytestring -}
import qualified Data.ByteString.Lazy as B.L {- bytestring -}
import qualified Data.ByteString.Lazy.UTF8 as U {- utf8-string -}
import qualified Data.Text as T {- text -}
import qualified Data.Text.Encoding as T {- text -}
import qualified Data.Text.Lazy as T.L {- text -}
import qualified Data.Text.Lazy.Encoding as T.L {- text -}
import System.Environment {- base -}

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

import qualified Sound.OSC.Type.JSON as J {- hosc-json -}
import qualified Sound.OSC.Type.JSON.Aeson as J {- hosc-json -}

die :: Show a => a -> t
die = error . show

type WithT = (O.Connection O.UDP () -> IO ())

handle_json :: MonadIO m => WithT -> J.Value -> m ()
handle_json withT j =
    case J.decode_packet j of
      Just o -> liftIO (withT (O.sendOSC o))
      _ -> die ("json_packet",j)

proc_lb :: MonadIO m => WithT -> B.L.ByteString -> m ()
proc_lb withT b =
    case J.decode_json b of
      Just j -> handle_json withT j
      _ -> die ("JSON.decode",b)

proc_b :: MonadIO m => WithT -> B.ByteString -> m ()
proc_b withT = proc_lb withT . B.L.fromStrict

proc_s :: MonadIO m => WithT -> String -> m ()
proc_s withT = proc_lb withT . U.fromString

proc_t :: MonadIO m => WithT -> T.Text -> m ()
proc_t withT = proc_b withT . T.encodeUtf8

proc_lt :: MonadIO m => WithT -> T.L.Text -> m ()
proc_lt withT = proc_lb withT . T.L.encodeUtf8

-- * Options

opt_parse :: [String] -> (String,Int,Int)
opt_parse a =
    case a of
      [] -> ("127.0.0.1",57110,9160)
      ["-h",h,"-p",p] -> (h,read p,9160)
      ["-h",h,"-p",p,"-w",w] -> (h,read p,read w)
      _ -> die ("-h host-name -p port-number -w port-number",a)

data Opt = Opt {with_t :: WithT
               ,o_host :: String
               ,w_port :: Int}

opt_arg :: MonadIO m => m Opt
opt_arg = do
  a <- liftIO getArgs
  let (h,p,w) = opt_parse a
  liftIO (print ("(h,p,w)=",(h,p,w)))
  return (Opt (O.withTransport (O.openUDP h p)) h w)