-- | Binary encoders and decoders.
module Sound.Sc3.Server.Graphdef.Binary where

import System.FilePath {- filepath -}

import qualified Data.Binary.Get as Get {- binary -}
import qualified Data.Binary.IEEE754 as IEEE754 {- data-binary-ieee754 -}
import qualified Data.ByteString.Lazy as ByteString {- bytestring -}

import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}
import qualified Sound.Osc.Coding.Cast as Cast {- hosc -}
import qualified Sound.Osc.Datum as Datum {- hosc -}

import Sound.Sc3.Server.Graphdef {- hsc3 -}

-- * Binary Get (version 0|1 or 2)

-- | Get a 'Name' (Pascal string).
get_pstr :: Get.Get Name
get_pstr :: Get Name
get_pstr = do
  Int64
n <- (Word8 -> Int64) -> Get Word8 -> Get Int64
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
Get.getWord8
  (ByteString -> Name) -> Get ByteString -> Get Name
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Name
Byte.decode_ascii (Int64 -> Get ByteString
Get.getLazyByteString Int64
n)

-- | Get_Functions for binary .scsyndef files.
binary_get_f :: Get_Functions Get.Get
binary_get_f :: Get_Functions Get
binary_get_f =
  ( Get Name
get_pstr
  , (Int8 -> Int) -> Get Int8 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int8
Get.getInt8
  , (Int16 -> Int) -> Get Int16 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int16
Get.getInt16be
  , (Int32 -> Int) -> Get Int32 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int32
Get.getInt32be
  , (Float -> Sample) -> Get Float -> Get Sample
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Sample
forall a b. (Real a, Fractional b) => a -> b
realToFrac Get Float
IEEE754.getFloat32be
  )

-- * Read

{- | Read Graphdef from .scsyndef file.

> dir = "/home/rohan/sw/rsc3-disassembler/scsyndef/"
> pp nm = read_graphdef_file (dir ++ nm) >>= putStrLn . graphdef_stat
> pp "simple.scsyndef"
> pp "with-ctl.scsyndef"
> pp "mce.scsyndef"
> pp "mrg.scsyndef"
-}
read_graphdef_file :: FilePath -> IO Graphdef
read_graphdef_file :: FilePath -> IO Graphdef
read_graphdef_file FilePath
nm = do
  ByteString
b <- FilePath -> IO ByteString
ByteString.readFile FilePath
nm
  Graphdef -> IO Graphdef
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Get Graphdef -> ByteString -> Graphdef
forall a. Get a -> ByteString -> a
Get.runGet (Get_Functions Get -> Get Graphdef
forall (m :: * -> *). Monad m => Get_Functions m -> m Graphdef
get_graphdef Get_Functions Get
binary_get_f) ByteString
b)

-- * Stat

-- | 'read_graphdef_file' and run 'graphdef_stat'.
scsyndef_stat :: FilePath -> IO String
scsyndef_stat :: FilePath -> IO FilePath
scsyndef_stat FilePath
fn = do
  Graphdef
g <- FilePath -> IO Graphdef
read_graphdef_file FilePath
fn
  FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Graphdef -> FilePath
graphdef_stat Graphdef
g)

-- * Encode (version zero)

-- | 'Encode_Functions' for 'ByteString.ByteString'
enc_bytestring :: Encode_Functions ByteString.ByteString
enc_bytestring :: Encode_Functions ByteString
enc_bytestring =
  ( [ByteString] -> ByteString
ByteString.concat
  , Name -> ByteString
encode_pstr
  , Int -> ByteString
Byte.encode_i8
  , Int -> ByteString
Byte.encode_i16
  , Int -> ByteString
Byte.encode_i32
  , Sample -> ByteString
encode_sample
  , ByteString -> FilePath -> ByteString
forall a b. a -> b -> a
const ByteString
ByteString.empty
  )

{- | Pascal (length prefixed) encoding of 'Name'.

> ByteString.unpack (encode_pstr (ascii "string")) ==  [6, 115, 116, 114, 105, 110, 103]
-}
encode_pstr :: Name -> ByteString.ByteString
encode_pstr :: Name -> ByteString
encode_pstr = [Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString) -> (Name -> [Word8]) -> Name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Word8]
Cast.str_pstr (FilePath -> [Word8]) -> (Name -> FilePath) -> Name -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
Datum.ascii_to_string

-- | Byte-encode 'Input'.
encode_input :: Input -> ByteString.ByteString
encode_input :: Input -> ByteString
encode_input = Encode_Functions ByteString -> Input -> ByteString
forall t. Encode_Functions t -> Input -> t
encode_input_f Encode_Functions ByteString
enc_bytestring

-- | Byte-encode 'Control'.
encode_control :: Control -> ByteString.ByteString
encode_control :: Control -> ByteString
encode_control = Encode_Functions ByteString -> Control -> ByteString
forall t. Encode_Functions t -> Control -> t
encode_control_f Encode_Functions ByteString
enc_bytestring

-- | Byte-encode 'Ugen'.
encode_ugen :: Ugen -> ByteString.ByteString
encode_ugen :: Ugen -> ByteString
encode_ugen = Encode_Functions ByteString -> Ugen -> ByteString
forall t. Encode_Functions t -> Ugen -> t
encode_ugen_f Encode_Functions ByteString
enc_bytestring

-- | Encode 'Sample' as 32-bit IEEE float.
encode_sample :: Sample -> ByteString.ByteString
encode_sample :: Sample -> ByteString
encode_sample = Float -> ByteString
Byte.encode_f32 (Float -> ByteString) -> (Sample -> Float) -> Sample -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Encode 'Graphdef'.
encode_graphdef :: Graphdef -> ByteString.ByteString
encode_graphdef :: Graphdef -> ByteString
encode_graphdef = Encode_Functions ByteString -> Graphdef -> ByteString
forall t. Encode_Functions t -> Graphdef -> t
encode_graphdef_f Encode_Functions ByteString
enc_bytestring

-- * IO

-- | Write 'Graphdef' to indicated file.
graphdefWrite :: FilePath -> Graphdef -> IO ()
graphdefWrite :: FilePath -> Graphdef -> IO ()
graphdefWrite FilePath
fn = FilePath -> ByteString -> IO ()
ByteString.writeFile FilePath
fn (ByteString -> IO ())
-> (Graphdef -> ByteString) -> Graphdef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graphdef -> ByteString
encode_graphdef

{- | Write 'Graphdef' to indicated directory.  The filename is the
'graphdef_name' with the appropriate extension (@scsyndef@).
-}
graphdefWrite_dir :: FilePath -> Graphdef -> IO ()
graphdefWrite_dir :: FilePath -> Graphdef -> IO ()
graphdefWrite_dir FilePath
dir Graphdef
s =
  let fn :: FilePath
fn = FilePath
dir FilePath -> FilePath -> FilePath
</> Name -> FilePath
Datum.ascii_to_string (Graphdef -> Name
graphdef_name Graphdef
s) FilePath -> FilePath -> FilePath
<.> FilePath
"scsyndef"
  in FilePath -> Graphdef -> IO ()
graphdefWrite FilePath
fn Graphdef
s