-- | Open Sound Control data

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

module Vivid.OSC (
     OSC(..)
   , OSCDatum(..)

   , encodeOSC
   , decodeOSC

   , Timestamp(..)
   , OSCBundle(..)

   , encodeOSCBundle
   , decodeOSCBundle

   , encodeTimestamp
   , utcToTimestamp
   -- , timestampToUTC

   , addSecs
   , diffTimestamps

   , encodeOSCDatum

   -- , decodeOSCDatumWithPadding
   -- , decodeOSCData

   -- Testing/internals:
   , putOSC
   , putOSCString
   , putOSCDatum
   , getOSCString
   , getOSC
   , putOSCBlob
   , getOSCBlob
   , getOSCTimestamp
   , putOSCTimestamp

   , putOSCBundle
   , getOSCBundle
   , runGetWithNoLeftover

   -- Only need for testing old<->new
   , toTypeChar
   , alignTo4'
   ) where

-- import Control.DeepSeq (NFData, rnf)
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8 (unpack)
import Data.Int (Int32)
import Data.Monoid
import Data.Serialize hiding (encode, decode, runGet)
-- import Data.Serialize.IEEE754
import qualified Data.Serialize.Get as Get
import Data.Time (UTCTime(..), fromGregorian, secondsToDiffTime, diffUTCTime)

-- | An OSC message, e.g.
-- 
--   > OSC "/n_free" [OSC_I 42]
data OSC
   = OSC ByteString [OSCDatum]
 deriving (Show, Read, Eq, Ord)

data OSCDatum
   = OSC_I Int32
   | OSC_S ByteString
   | OSC_F Float
   | OSC_D Double -- ^ This isn't a base type in the OSC standard but the
                  -- scsynth response message from "/status" uses it...
{-
   | OSC_I8 Int8
   | OSC_I16 Int16
-}
   | OSC_B ByteString
   | OSC_T Timestamp -- ^ From the OSC 1.1 spec
 deriving (Show, Read, Eq, Ord)

-- | This is stored as the number of seconds since Jan 1 1900. You can get
--   it with 'Vivid.Actions.Class.getTime'
newtype Timestamp = Timestamp Double
   deriving (Show, Read, Eq, Ord)

-- | TODO: a Bundle can also contain other bundles, recursively
data OSCBundle
   = OSCBundle Timestamp [Either ByteString OSC]
 deriving (Show, Read, Eq)

toTypeChar :: OSCDatum -> ByteString
toTypeChar = \case
   OSC_I _ -> "i"
   OSC_S _ -> "s"
   OSC_F _ -> "f"
   OSC_B _ -> "b"
   OSC_D _ -> "d"
   OSC_T _ -> "t"

-- formerly known as 'someShit':
-- TODO: if sometimes encoding can fail (e.g. if a string contains a '\NUL'), we
-- should really have a (Either String) situation (and same for 'encodeOSCDatum'):
encodeOSC :: OSC -> ByteString
encodeOSC o = runPut (putOSC o)

putOSC :: OSC -> Put
putOSC (OSC path args) = do
   putOSCString path
   putOSCString $ "," <> BS.concat (map toTypeChar args)
   mapM_ putOSCDatum args

encodeOSCDatum :: OSCDatum -> ByteString
encodeOSCDatum = runPut . putOSCDatum

putOSCDatum :: OSCDatum -> Put
putOSCDatum = \case
   OSC_S s -> putOSCString s
   OSC_I i -> putInt32be i
   OSC_F f -> putFloat32be f
   OSC_D d -> putFloat64be d
   OSC_T t -> putOSCTimestamp t
   OSC_B b -> putOSCBlob b

putOSCString :: ByteString -> Put
putOSCString s = do
    -- There must be at least one \NUL byte:
   putByteString $ padTo4Bytes (s<>"\NUL")

getOSCString :: Get ByteString
getOSCString = do
   -- There may be a more efficient way to do this:
   first <- BS.takeWhile (/= 0) <$> getByteString 4
   case BS.length first of
      4 -> do
         (first <>) <$> getOSCString
      -- Note we've already discarded the ending '\NUL' padding:
      _ -> pure first

-- | Add '\NUL' characters to the end of a ByteString until its length is
--   a multiple of 4
-- TODO: make this be a 'Put' and just get like the 'seek' count so we don't have to traverse it twice:
padTo4Bytes :: ByteString -> ByteString
padTo4Bytes b = b <> BS.replicate (alignTo4' (BS.length b)) 0

putOSCBlob :: ByteString -> Put
putOSCBlob bs = do
   -- Note: should probably really be word:
   putInt32be $ toEnum $ BS.length bs
   -- The only reason we don't account for the prefixed length is that's
   -- always 4 bytes long so it won't affect the padding:
   putByteString $ padTo4Bytes bs

getOSCBlob :: Get ByteString
getOSCBlob = do
   size <- fromEnum <$> getInt32be
   b <- getByteString size
   _ <- getByteString (alignTo4' size) -- TODO; 'seek' instead?
   pure b

decodeOSC :: ByteString -> Either String OSC
decodeOSC = runGet getOSC

getOSC :: Get OSC
getOSC = do
   path <- getOSCString
   -- For example, ",issifbt":
   (comma:typeDesc) <- BS8.unpack <$> getOSCString
   when (comma /= ',') $ fail "Malformed OSC!"
   values <- forM typeDesc $ \case
      's' -> OSC_S <$> getOSCString
      'i' -> OSC_I <$> getInt32be
      'f' -> OSC_F <$> getFloat32be
      't' -> OSC_T <$> getOSCTimestamp
      'd' -> OSC_D <$> getFloat64be
      'b' -> OSC_B <$> getOSCBlob
      c -> fail $ "Unrecognized character: " ++ show c
   pure (OSC path values)

encodeOSCBundle :: OSCBundle -> ByteString
encodeOSCBundle b = runPut (putOSCBundle b)

putOSCBundle :: OSCBundle -> Put
putOSCBundle (OSCBundle time messages) = do
   putByteString "#bundle\NUL"
   putOSCTimestamp time
   forM_ messages $ \message -> do
      let encoded = case message of
           Left b -> b
           -- TODO: Doesn't feel right that i have a 'runPut' inside a 'Put':
           Right osc -> runPut $ putOSC osc
      putWord32be $ toEnum $ BS.length encoded
      putByteString encoded

decodeOSCBundle :: ByteString -> Either String OSCBundle
decodeOSCBundle = runGet getOSCBundle

getOSCBundle :: Get OSCBundle
getOSCBundle = do
   let prefix = "#bundle\NUL"
   pre <- getByteString (BS.length prefix)
   when (pre /= prefix) $
      fail "Wrong header"
   ts <- getOSCTimestamp
   messages <- getListTillEnd $ do
      len <- fromEnum <$> getWord32be
      Right <$> isolate len getOSC
   pure $ OSCBundle ts messages

-- There might be a more efficient way to write this?:
getListTillEnd :: Get x -> Get [x]
getListTillEnd getAction = isEmpty >>= \case
   True -> pure []
   False -> do
      r <- getAction
      (r:) <$> getListTillEnd getAction

encodeTimestamp :: Timestamp -> ByteString
encodeTimestamp t = runPut (putOSCTimestamp t)

putOSCTimestamp :: Timestamp -> Put
putOSCTimestamp (Timestamp t) =
   putWord64be $ round $ t * 2^(32::Int)

getOSCTimestamp :: Get Timestamp
getOSCTimestamp = do
   w <- {- realToFrac -} fromIntegral <$> getWord64be
   pure $ Timestamp $ w / 2 ** 32 -- (2^(32::Int))

utcToTimestamp :: UTCTime -> Timestamp
utcToTimestamp utcTime =
   let startOfTheCentury =
          UTCTime (fromGregorian 1900 1 1) (secondsToDiffTime 0)
   in Timestamp . realToFrac $ diffUTCTime utcTime startOfTheCentury

_timestampToUTC :: Timestamp -> UTCTime
_timestampToUTC = undefined

addSecs :: Timestamp -> Double -> Timestamp
addSecs (Timestamp t) secs = Timestamp (t + secs)

diffTimestamps :: Timestamp -> Timestamp -> Double
diffTimestamps (Timestamp t1) (Timestamp t0) = t1 - t0

{-
instance NFData OSCDatum where
   rnf (OSC_I x) = rnf x
   rnf (OSC_F x) = rnf x
   rnf (OSC_S x) = rnf x
{-
   rnf (OSC_I8 x) = rnf x
   rnf (OSC_I16 x) = rnf x
-}
   rnf (OSC_B x) = rnf x
-}

-- Makes sure we've consumed all input:
runGet :: Get a -> ByteString -> Either String a
runGet g = Get.runGet $ do
   x <- g
   isEmpty >>= \case
      True -> pure x
      False -> fail $ "Leftover bytes #2"

-- With an exportable name:
runGetWithNoLeftover :: Get a -> ByteString -> Either String a
runGetWithNoLeftover = runGet

-- Everything in OSC has to be a multiple of 4 bytes, so this is handy:
alignTo4' :: Integral i => i -> i
alignTo4' n = (4 - (n `rem` 4)) `mod` 4