-- Copyright 2020 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Low level binding to faust dsps, specialized for ones that process
-- audio, rather than generating it.
module Synth.Faust.EffectC (
    EffectT(_name, _doc, _controls)
    , Patch, Effect
    , State
    -- * Patch
    , get, patches
    -- * Effect
    , allocate, destroy
    , render
    -- ** state
    , getState, unsafeGetState, putState
) where
import qualified Data.ByteString as ByteString
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Vector.Storable as V

import qualified System.IO.Unsafe as Unsafe

import qualified Util.Audio.Audio as Audio
import qualified Util.Serialize as Serialize
import qualified Synth.Faust.PatchC as PatchC
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note

import           ForeignC
import           Global


data EffectT ptr cptr = EffectT {
    forall ptr cptr. EffectT ptr cptr -> Text
_name :: !Text
    , forall ptr cptr. EffectT ptr cptr -> Text
_doc :: !Text
    , forall ptr cptr. EffectT ptr cptr -> Map Control (cptr, Text)
_controls :: !(Map Control.Control (cptr, Text))
    , forall ptr cptr. EffectT ptr cptr -> ptr
_ptr :: !ptr
    } deriving (Int -> EffectT ptr cptr -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ptr cptr.
(Show cptr, Show ptr) =>
Int -> EffectT ptr cptr -> ShowS
forall ptr cptr.
(Show cptr, Show ptr) =>
[EffectT ptr cptr] -> ShowS
forall ptr cptr.
(Show cptr, Show ptr) =>
EffectT ptr cptr -> String
showList :: [EffectT ptr cptr] -> ShowS
$cshowList :: forall ptr cptr.
(Show cptr, Show ptr) =>
[EffectT ptr cptr] -> ShowS
show :: EffectT ptr cptr -> String
$cshow :: forall ptr cptr.
(Show cptr, Show ptr) =>
EffectT ptr cptr -> String
showsPrec :: Int -> EffectT ptr cptr -> ShowS
$cshowsPrec :: forall ptr cptr.
(Show cptr, Show ptr) =>
Int -> EffectT ptr cptr -> ShowS
Show)

-- | A patch can be used to create 'Effect's.
type Patch = EffectT PatchC.PatchP ()

-- | An allocated patch.
type Effect = EffectT PatchC.InstrumentP (Ptr Float)


-- * Patch

get :: Text -> IO Patch
get :: Text -> IO Patch
get Text
name = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Map Text (Either Text Patch)
patches of
    Just (Right Patch
patch) -> forall (m :: * -> *) a. Monad m => a -> m a
return Patch
patch
    Just (Left Text
err) -> forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"effect " forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
err
    Maybe (Either Text Patch)
Nothing -> forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"no effect: " forall a. Semigroup a => a -> a -> a
<> Text
name

-- | All configured effects.
patches :: Map Text (Either Text Patch)
patches :: Map Text (Either Text Patch)
patches = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    [(Text, PatchP)]
namePatches <- forall a. (a -> Bool) -> [a] -> [a]
filter ((Text
"effect-" `Text.isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        IO [(Text, PatchP)]
PatchC.patches
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
        forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"effect-") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, PatchP)]
namePatches)
            (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> PatchP -> Either Text Patch
getPatchP) [(Text, PatchP)]
namePatches)
    -- unsafePerformIO is ok for these since they are just looking up static
    -- data from C.

getPatchP :: Text -> PatchC.PatchP -> Either Text Patch
getPatchP :: Text -> PatchP -> Either Text Patch
getPatchP Text
name PatchP
patch = forall a. IO a -> a
Unsafe.unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Map Text Text
meta <- PatchP -> IO (Map Text Text)
PatchC.getMetadata PatchP
patch
    [(([Text], Control), Text)]
ui <- PatchP -> IO [(([Text], Control), Text)]
PatchC.getUiControls PatchP
patch
    let inputs :: Int
inputs = PatchP -> Int
PatchC.patchInputs PatchP
patch
        outputs :: Int
outputs = PatchP -> Int
PatchC.patchOutputs PatchP
patch
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> Map Text Text
-> [(Control, Text)]
-> Int
-> Int
-> PatchP
-> Either Text Patch
makePatch Text
name Map Text Text
meta (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a b. (a, b) -> b
snd) [(([Text], Control), Text)]
ui) Int
inputs Int
outputs PatchP
patch

makePatch :: Text -> Map Text Text -> [(Control.Control, Text)]
    -> Int -> Int -> PatchC.PatchP -> Either Text Patch
makePatch :: Text
-> Map Text Text
-> [(Control, Text)]
-> Int
-> Int
-> PatchP
-> Either Text Patch
makePatch Text
name Map Text Text
meta [(Control, Text)]
uis Int
inputs Int
outputs PatchP
ptr = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
name forall a. Semigroup a => a -> a -> a
<> Text
": ")<>) forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
inputs forall a. Eq a => a -> a -> Bool
== Int
2) forall a b. (a -> b) -> a -> b
$
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"expected 2 inputs, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
inputs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
outputs forall a. Eq a => a -> a -> Bool
== Int
2) forall a b. (a -> b) -> a -> b
$
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"expected 2 outputs, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
outputs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EffectT
        { _name :: Text
_name = Text
name
        , _doc :: Text
_doc = Map Text Text -> Text
PatchC.parseDescription Map Text Text
meta
        , _controls :: Map Control ((), Text)
_controls =
            forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Control
control, ((), Text
doc)) | (Control
control, Text
doc) <- [(Control, Text)]
uis]
        , _ptr :: PatchP
_ptr = PatchP
ptr
        }

-- * Effect

allocate :: Patch -> IO Effect
allocate :: Patch -> IO Effect
allocate Patch
patch = do
    (InstrumentP
ptr, [(([Text], Control), Ptr Float)]
controls) <- PatchP -> IO (InstrumentP, [(([Text], Control), Ptr Float)])
PatchC.allocate (forall ptr cptr. EffectT ptr cptr -> ptr
_ptr Patch
patch)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Patch
patch
        { _ptr :: InstrumentP
_ptr = InstrumentP
ptr
        , _controls :: Map Control (Ptr Float, Text)
_controls = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Control
control, (Ptr Float
cptr, Control -> Text
getDoc Control
control))
            | (([Text]
_, Control
control), Ptr Float
cptr) <- [(([Text], Control), Ptr Float)]
controls
            ]
        }
    where
    -- A Nothing means getUiControls returned different controls than it did
    -- when the 'Patch' was constructed, which should not happen.
    getDoc :: Control -> Text
getDoc Control
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Control
c (forall ptr cptr. EffectT ptr cptr -> Map Control (cptr, Text)
_controls Patch
patch)

destroy :: Effect -> IO ()
destroy :: Effect -> IO ()
destroy = InstrumentP -> IO ()
PatchC.c_faust_destroy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ptr cptr. EffectT ptr cptr -> ptr
_ptr

-- | Render chunk of time and return samples.
render :: Audio.Frames -> Audio.Frames -> Effect
    -> [(Ptr Float, Audio.Block)]
    -> [V.Vector Float] -- ^ Input signals.  The length must be equal to the
    -- the patchInputs, and each vector must have the same length.
    -> IO [V.Vector Float] -- ^ one block of samples for each output channel
render :: Frames
-> Frames
-> Effect
-> [(Ptr Float, Block)]
-> [Vector Float]
-> IO [Vector Float]
render Frames
controlSize Frames
controlsPerBlock Effect
effect =
    Frames
-> Frames
-> InstrumentP
-> [(Ptr Float, Block)]
-> [Vector Float]
-> IO [Vector Float]
PatchC.render Frames
controlSize Frames
controlsPerBlock (forall ptr cptr. EffectT ptr cptr -> ptr
_ptr Effect
effect)

-- ** state

newtype State = State ByteString.ByteString
    deriving (Get State
Putter State
forall a. Putter a -> Get a -> Serialize a
get :: Get State
$cget :: Get State
put :: Putter State
$cput :: Putter State
Serialize.Serialize)

instance Pretty State where
    pretty :: State -> Text
pretty (State ByteString
bytes) = String -> Text
txt forall a b. (a -> b) -> a -> b
$ ByteString -> String
Note.fingerprintBytes ByteString
bytes

getState :: Effect -> IO State
getState :: Effect -> IO State
getState = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> State
State forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrumentP -> IO ByteString
PatchC.getState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ptr cptr. EffectT ptr cptr -> ptr
_ptr

-- | 'getState', but without copying, if you promise to finish with the State
-- before you call 'render', which will change it.
unsafeGetState :: Effect -> IO State
unsafeGetState :: Effect -> IO State
unsafeGetState = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> State
State forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrumentP -> IO ByteString
PatchC.unsafeGetState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ptr cptr. EffectT ptr cptr -> ptr
_ptr

putState :: Effect -> State -> IO ()
putState :: Effect -> State -> IO ()
putState Effect
effect (State ByteString
state) =
    ByteString -> Text -> InstrumentP -> IO ()
PatchC.putState ByteString
state (forall ptr cptr. EffectT ptr cptr -> Text
_name Effect
effect) (forall ptr cptr. EffectT ptr cptr -> ptr
_ptr Effect
effect)