-- | 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 L {- 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
Get.getWord8
  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
  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int8
Get.getInt8
  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int16
Get.getInt16be
  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int32
Get.getInt32be
  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
L.readFile FilePath
nm
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Get a -> ByteString -> a
Get.runGet (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
  forall (m :: * -> *) a. Monad m => a -> m a
return (Graphdef -> FilePath
graphdef_stat Graphdef
g)

-- * Encode (version zero)

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


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

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


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

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

-- | Byte-encode 'Ugen'.
encode_ugen :: Ugen -> L.ByteString
encode_ugen :: Ugen -> ByteString
encode_ugen = 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 -> L.ByteString
encode_sample :: Sample -> ByteString
encode_sample = Float -> ByteString
Byte.encode_f32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Encode 'Graphdef'.
encode_graphdef :: Graphdef -> L.ByteString
encode_graphdef :: Graphdef -> ByteString
encode_graphdef = 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 ()
L.writeFile FilePath
fn 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