hosc-utils-0.14: hs/json-cgi.hs

import Data.List {- base -}
import qualified Network.CGI as C {- cgi -}
import Sound.OSC.Type.JSON {- hosc-json -}
import Sound.OSC {- hosc -}
import qualified WWW.Minus.CGI as W {- www-minus -}

import qualified U

err :: Show a => a -> W.Result
err e = W.utf8_text_output ("json-cgi: error: " ++ show e)

handle_json :: U.WithT -> Value -> W.Result
handle_json withT j =
    case decode_packet j of
      Just o -> do C.liftIO (withT (sendOSC o))
                   W.utf8_text_output ("json-cgi: sent: " ++ show o)
      _ -> err ("json_packet",j)

dispatch_get :: W.Query -> W.Result
dispatch_get q =
    let h = U.lookup_with_def "h" "127.0.0.1" q
        p = read (U.lookup_with_def "p" "57110" q)
    in case lookup "j" q of
         Just s -> case decode_json_str s of
                     Just j -> let t = withTransport (openUDP h p)
                               in handle_json t j
                     _ -> err ("JSON.decode",s)
         _ -> err ("GET",q)

dispatch :: () -> W.Dispatch
dispatch () (m,_,q) =
    case m of
      "GET" -> dispatch_get q
      _ -> err ("dispatch",m)

main :: IO ()
main = W.run_cgi () dispatch