-- Copyright 2018 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 -- | General utilities for sampler patches. module Synth.Sampler.Patch.Lib.Util where import qualified Control.Monad.Except as Except import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Text as Text import qualified GHC.Stack as Stack import qualified Util.Maps as Maps import qualified Util.Num as Num import qualified Util.Seq as Seq import qualified Cmd.Instrument.CUtil as CUtil import qualified Cmd.Instrument.ImInst as ImInst import qualified Derive.Attrs as Attrs import qualified Instrument.Common as Common import qualified Perform.Pitch as Pitch import qualified Perform.RealTime as RealTime import qualified Synth.Sampler.Patch as Patch import qualified Synth.Sampler.Sample as Sample import qualified Synth.Shared.Control as Control import qualified Synth.Shared.Note as Note import qualified Synth.Shared.Thru as Thru import qualified Synth.Shared.Signal as Signal import Global -- * preprocess nextsBy :: Eq key => (a -> key) -> [a] -> [(a, [a])] nextsBy :: forall key a. Eq key => (a -> key) -> [a] -> [(a, [a])] nextsBy a -> key key [a] xs = (a -> [a] -> (a, [a])) -> [a] -> [[a]] -> [(a, [a])] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith a -> [a] -> (a, [a]) extract [a] xs (Int -> [[a]] -> [[a]] forall a. Int -> [a] -> [a] drop Int 1 ([a] -> [[a]] forall a. [a] -> [[a]] List.tails [a] xs)) where extract :: a -> [a] -> (a, [a]) extract a x [a] xs = (a x, (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] filter ((key -> key -> Bool forall a. Eq a => a -> a -> Bool == a -> key key a x) (key -> Bool) -> (a -> key) -> a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> key key) [a] xs) nexts :: [a] -> [(a, [a])] nexts :: forall a. [a] -> [(a, [a])] nexts [a] xs = [a] -> [[a]] -> [(a, [a])] forall a b. [a] -> [b] -> [(a, b)] zip [a] xs (Int -> [[a]] -> [[a]] forall a. Int -> [a] -> [a] drop Int 1 ([a] -> [[a]] forall a. [a] -> [[a]] List.tails [a] xs)) -- * convert -- ** pitch symbolicPitch :: Except.MonadError Text m => Note.Note -> m (Either Pitch.Note Pitch.NoteNumber) symbolicPitch :: forall (m :: * -> *). MonadError Error m => Note -> m (Either Note NoteNumber) symbolicPitch Note note | Error -> Bool Text.null (Note -> Error Note.element Note note) = NoteNumber -> Either Note NoteNumber forall a b. b -> Either a b Right (NoteNumber -> Either Note NoteNumber) -> m NoteNumber -> m (Either Note NoteNumber) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Note -> m NoteNumber forall (m :: * -> *). MonadError Error m => Note -> m NoteNumber initialPitch Note note | Bool otherwise = Either Note NoteNumber -> m (Either Note NoteNumber) forall (m :: * -> *) a. Monad m => a -> m a return (Either Note NoteNumber -> m (Either Note NoteNumber)) -> Either Note NoteNumber -> m (Either Note NoteNumber) forall a b. (a -> b) -> a -> b $ Note -> Either Note NoteNumber forall a b. a -> Either a b Left (Note -> Either Note NoteNumber) -> Note -> Either Note NoteNumber forall a b. (a -> b) -> a -> b $ Error -> Note Pitch.Note (Error -> Note) -> Error -> Note forall a b. (a -> b) -> a -> b $ Note -> Error Note.element Note note initialPitch :: Except.MonadError Text m => Note.Note -> m Pitch.NoteNumber initialPitch :: forall (m :: * -> *). MonadError Error m => Note -> m NoteNumber initialPitch = Error -> Maybe NoteNumber -> m NoteNumber forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a tryJust Error "no pitch" (Maybe NoteNumber -> m NoteNumber) -> (Note -> Maybe NoteNumber) -> Note -> m NoteNumber forall b c a. (b -> c) -> (a -> b) -> a -> c . Note -> Maybe NoteNumber Note.initialPitch -- | Find a value (presumably a FileName) and pitch ratio for a simple patch -- with a static NoteNumber mapping. findPitchRatio :: Map Pitch.NoteNumber a -> Pitch.NoteNumber -> (a, Signal.Y) findPitchRatio :: forall a. Map NoteNumber a -> NoteNumber -> (a, Y) findPitchRatio Map NoteNumber a nnToSample NoteNumber nn = (a fname, NoteNumber -> NoteNumber -> Y Sample.pitchToRatio NoteNumber sampleNn NoteNumber nn) where (NoteNumber sampleNn, a fname) = (NoteNumber, a) -> Maybe (NoteNumber, a) -> (NoteNumber, a) forall a. a -> Maybe a -> a fromMaybe ([Char] -> (NoteNumber, a) forall a. HasCallStack => [Char] -> a error [Char] "findPitch: empty nnToSample") (Maybe (NoteNumber, a) -> (NoteNumber, a)) -> Maybe (NoteNumber, a) -> (NoteNumber, a) forall a b. (a -> b) -> a -> b $ NoteNumber -> Map NoteNumber a -> Maybe (NoteNumber, a) forall k v. (Ord k, Num k) => k -> Map k v -> Maybe (k, v) Maps.lookupClosest NoteNumber nn Map NoteNumber a nnToSample -- ** articulation articulation :: Except.MonadError Text m => Common.AttributeMap a -> Attrs.Attributes -> m a articulation :: forall (m :: * -> *) a. MonadError Error m => AttributeMap a -> Attributes -> m a articulation AttributeMap a attributeMap Attributes attrs = m a -> ((Attributes, a) -> m a) -> Maybe (Attributes, a) -> m a forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a Except.throwError (Error -> m a) -> Error -> m a forall a b. (a -> b) -> a -> b $ Error "attributes not found: " Error -> Error -> Error forall a. Semigroup a => a -> a -> a <> Attributes -> Error forall a. Pretty a => a -> Error pretty Attributes attrs) (a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (a -> m a) -> ((Attributes, a) -> a) -> (Attributes, a) -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . (Attributes, a) -> a forall a b. (a, b) -> b snd) (Maybe (Attributes, a) -> m a) -> Maybe (Attributes, a) -> m a forall a b. (a -> b) -> a -> b $ Attributes -> AttributeMap a -> Maybe (Attributes, a) forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a) Common.lookup_attributes Attributes attrs AttributeMap a attributeMap articulationDefault :: a -> Common.AttributeMap a -> Attrs.Attributes -> a articulationDefault :: forall a. a -> AttributeMap a -> Attributes -> a articulationDefault a deflt AttributeMap a attributeMap = a -> ((Attributes, a) -> a) -> Maybe (Attributes, a) -> a forall b a. b -> (a -> b) -> Maybe a -> b maybe a deflt (Attributes, a) -> a forall a b. (a, b) -> b snd (Maybe (Attributes, a) -> a) -> (Attributes -> Maybe (Attributes, a)) -> Attributes -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . (Attributes -> AttributeMap a -> Maybe (Attributes, a) forall a. Attributes -> AttributeMap a -> Maybe (Attributes, a) `Common.lookup_attributes` AttributeMap a attributeMap) -- ** dynamic -- | Standard dynamic ranges. data Dynamic = PP | MP | MF | FF deriving (Dynamic -> Dynamic -> Bool (Dynamic -> Dynamic -> Bool) -> (Dynamic -> Dynamic -> Bool) -> Eq Dynamic forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Dynamic -> Dynamic -> Bool $c/= :: Dynamic -> Dynamic -> Bool == :: Dynamic -> Dynamic -> Bool $c== :: Dynamic -> Dynamic -> Bool Eq, Eq Dynamic Eq Dynamic -> (Dynamic -> Dynamic -> Ordering) -> (Dynamic -> Dynamic -> Bool) -> (Dynamic -> Dynamic -> Bool) -> (Dynamic -> Dynamic -> Bool) -> (Dynamic -> Dynamic -> Bool) -> (Dynamic -> Dynamic -> Dynamic) -> (Dynamic -> Dynamic -> Dynamic) -> Ord Dynamic Dynamic -> Dynamic -> Bool Dynamic -> Dynamic -> Ordering Dynamic -> Dynamic -> Dynamic forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Dynamic -> Dynamic -> Dynamic $cmin :: Dynamic -> Dynamic -> Dynamic max :: Dynamic -> Dynamic -> Dynamic $cmax :: Dynamic -> Dynamic -> Dynamic >= :: Dynamic -> Dynamic -> Bool $c>= :: Dynamic -> Dynamic -> Bool > :: Dynamic -> Dynamic -> Bool $c> :: Dynamic -> Dynamic -> Bool <= :: Dynamic -> Dynamic -> Bool $c<= :: Dynamic -> Dynamic -> Bool < :: Dynamic -> Dynamic -> Bool $c< :: Dynamic -> Dynamic -> Bool compare :: Dynamic -> Dynamic -> Ordering $ccompare :: Dynamic -> Dynamic -> Ordering Ord, Int -> Dynamic -> ShowS [Dynamic] -> ShowS Dynamic -> [Char] (Int -> Dynamic -> ShowS) -> (Dynamic -> [Char]) -> ([Dynamic] -> ShowS) -> Show Dynamic forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a showList :: [Dynamic] -> ShowS $cshowList :: [Dynamic] -> ShowS show :: Dynamic -> [Char] $cshow :: Dynamic -> [Char] showsPrec :: Int -> Dynamic -> ShowS $cshowsPrec :: Int -> Dynamic -> ShowS Show, ReadPrec [Dynamic] ReadPrec Dynamic Int -> ReadS Dynamic ReadS [Dynamic] (Int -> ReadS Dynamic) -> ReadS [Dynamic] -> ReadPrec Dynamic -> ReadPrec [Dynamic] -> Read Dynamic forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Dynamic] $creadListPrec :: ReadPrec [Dynamic] readPrec :: ReadPrec Dynamic $creadPrec :: ReadPrec Dynamic readList :: ReadS [Dynamic] $creadList :: ReadS [Dynamic] readsPrec :: Int -> ReadS Dynamic $creadsPrec :: Int -> ReadS Dynamic Read, Dynamic Dynamic -> Dynamic -> Bounded Dynamic forall a. a -> a -> Bounded a maxBound :: Dynamic $cmaxBound :: Dynamic minBound :: Dynamic $cminBound :: Dynamic Bounded, Int -> Dynamic Dynamic -> Int Dynamic -> [Dynamic] Dynamic -> Dynamic Dynamic -> Dynamic -> [Dynamic] Dynamic -> Dynamic -> Dynamic -> [Dynamic] (Dynamic -> Dynamic) -> (Dynamic -> Dynamic) -> (Int -> Dynamic) -> (Dynamic -> Int) -> (Dynamic -> [Dynamic]) -> (Dynamic -> Dynamic -> [Dynamic]) -> (Dynamic -> Dynamic -> [Dynamic]) -> (Dynamic -> Dynamic -> Dynamic -> [Dynamic]) -> Enum Dynamic forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a enumFromThenTo :: Dynamic -> Dynamic -> Dynamic -> [Dynamic] $cenumFromThenTo :: Dynamic -> Dynamic -> Dynamic -> [Dynamic] enumFromTo :: Dynamic -> Dynamic -> [Dynamic] $cenumFromTo :: Dynamic -> Dynamic -> [Dynamic] enumFromThen :: Dynamic -> Dynamic -> [Dynamic] $cenumFromThen :: Dynamic -> Dynamic -> [Dynamic] enumFrom :: Dynamic -> [Dynamic] $cenumFrom :: Dynamic -> [Dynamic] fromEnum :: Dynamic -> Int $cfromEnum :: Dynamic -> Int toEnum :: Int -> Dynamic $ctoEnum :: Int -> Dynamic pred :: Dynamic -> Dynamic $cpred :: Dynamic -> Dynamic succ :: Dynamic -> Dynamic $csucc :: Dynamic -> Dynamic Enum) instance Pretty Dynamic where pretty :: Dynamic -> Error pretty = Dynamic -> Error forall a. Show a => a -> Error showt -- | Get patch-specific dyn category, and note dynamic. dynamic :: (Bounded dyn, Enum dyn) => (dyn -> (Int, Int)) -- ^ Returns velocity instead of dyn, and the lower bound is unnecessary, -- for compatibility. -> Signal.Y -- ^ Min dyn. This is for normalized samples, where 0 gets this dyn. -> Note.Note -> (dyn, Signal.Y) dynamic :: forall dyn. (Bounded dyn, Enum dyn) => (dyn -> (Int, Int)) -> Y -> Note -> (dyn, Y) dynamic dyn -> (Int, Int) dynToRange Y minDyn Note note = ( (dyn, Y) -> dyn forall a b. (a, b) -> a fst ((dyn, Y) -> dyn) -> (dyn, Y) -> dyn forall a b. (a -> b) -> a -> b $ (dyn -> Y) -> Y -> (dyn, Y) forall dyn. (Bounded dyn, Enum dyn) => (dyn -> Y) -> Y -> (dyn, Y) findDynamic (Int -> Y velToDyn (Int -> Y) -> (dyn -> Int) -> dyn -> Y forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int, Int) -> Int forall a b. (a, b) -> b snd ((Int, Int) -> Int) -> (dyn -> (Int, Int)) -> dyn -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . dyn -> (Int, Int) dynToRange) Y dyn , Y -> Y -> Y -> Y forall a. (Eq a, Num a) => a -> a -> a -> a Num.scale Y minDyn Y 1 Y dyn ) where dyn :: Y dyn = Control -> Note -> Y Note.initial0 Control Control.dynamic Note note -- | Convert to (Dynamic, DistanceFromPrevDynamic) findDynamic :: (Bounded dyn, Enum dyn) => (dyn -> Signal.Y) -> Signal.Y -> (dyn, Signal.Y) findDynamic :: forall dyn. (Bounded dyn, Enum dyn) => (dyn -> Y) -> Y -> (dyn, Y) findDynamic dyn -> Y dynToRange Y dyn = Y -> Y -> [(Y, dyn)] -> (dyn, Y) forall {t} {a}. (Ord t, Fractional t) => t -> t -> [(t, a)] -> (a, t) find Y 0 Y dyn [(Y, dyn)] rangeDynamics where find :: t -> t -> [(t, a)] -> (a, t) find t low t val ((t high, a dyn) : [(t, a)] rest) | [(t, a)] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [(t, a)] rest Bool -> Bool -> Bool || t val t -> t -> Bool forall a. Ord a => a -> a -> Bool < t high = (a dyn, t -> t -> t -> t forall a. (Eq a, Fractional a) => a -> a -> a -> a Num.normalize t low t high t val) | Bool otherwise = t -> t -> [(t, a)] -> (a, t) find t high t val [(t, a)] rest find t _ t _ [] = [Char] -> (a, t) forall a. HasCallStack => [Char] -> a error [Char] "empty rangeDynamics" rangeDynamics :: [(Y, dyn)] rangeDynamics = (dyn -> Y) -> [dyn] -> [(Y, dyn)] forall a k. (a -> k) -> [a] -> [(k, a)] Seq.key_on dyn -> Y dynToRange [dyn] forall a. (Enum a, Bounded a) => [a] enumAll type Variation = Int variation :: Variation -> Note.Note -> Variation variation :: Int -> Note -> Int variation Int variations = Y -> Int forall {a} {b}. (RealFrac a, Integral b) => a -> b pick (Y -> Int) -> (Note -> Y) -> Note -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Control -> Note -> Y Note.initial0 Control Control.variation where pick :: a -> b pick a var = a -> b forall a b. (RealFrac a, Integral b) => a -> b round (a var a -> a -> a forall a. Num a => a -> a -> a * Int -> a forall a b. (Integral a, Num b) => a -> b fromIntegral (Int variations Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1)) chooseVariation :: [a] -> Note.Note -> a chooseVariation :: forall a. [a] -> Note -> a chooseVariation [a] as = [a] -> Y -> a forall a. [a] -> Y -> a pickVariation [a] as (Y -> a) -> (Note -> Y) -> Note -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Control -> Note -> Y Note.initial0 Control Control.variation pickVariation :: [a] -> Double -> a pickVariation :: forall a. [a] -> Y -> a pickVariation [a] as Y var = [a] as [a] -> Int -> a forall a. [a] -> Int -> a !! Y -> Int forall a b. (RealFrac a, Integral b) => a -> b round (Y -> Y -> Y -> Y forall a. Ord a => a -> a -> a -> a Num.clamp Y 0 Y 1 Y var Y -> Y -> Y forall a. Num a => a -> a -> a * Int -> Y forall a b. (Integral a, Num b) => a -> b fromIntegral ([a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] as Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1)) -- | Pick from a list of dynamic variations. pickDynamicVariation :: Double -> [a] -> Double -> Double -> a pickDynamicVariation :: forall a. Y -> [a] -> Y -> Y -> a pickDynamicVariation Y variationRange [a] samples Y dyn Y var = [a] -> Y -> a forall a. [a] -> Y -> a pickVariation [a] samples (Y -> Y -> Y -> Y forall a. Ord a => a -> a -> a -> a Num.clamp Y 0 Y 1 (Y dyn Y -> Y -> Y forall a. Num a => a -> a -> a + Y var Y -> Y -> Y forall a. Num a => a -> a -> a * Y variationRange)) -- | Scale dynamic for non-normalized samples, recorded with few dynamic -- levels. Since each sample already has its own dynamic level, if I do no -- scaling, then there will be noticeable bumps as the dynamic thresholds -- are crossed. So I scale the dynamics of each one by an adjustment to smooth -- the bumps. But the result will be more bumpy if each sample covers a -- different width of dynamic range, so I also scale the adjustment by -- that width. -- -- TODO I think it doesn't actually work though, I need to adjust manually -- per-sample. dynamicAutoScale :: (Signal.Y, Signal.Y) -> (Signal.Y, Signal.Y) -> Signal.Y -> Signal.Y dynamicAutoScale :: (Y, Y) -> (Y, Y) -> Y -> Y dynamicAutoScale (Y minDyn, Y maxDyn) (Y low, Y high) Y dyn = Y -> Y -> Y -> Y forall a. (Eq a, Num a) => a -> a -> a -> a Num.scale Y minDyn Y maxDyn Y biased where -- dyn should be in the (low, high) range already. pos :: Y pos = Y -> Y -> Y -> Y forall a. (Eq a, Fractional a) => a -> a -> a -> a Num.normalize Y low Y high Y dyn -- bias the position toward the middle of the dyn range, depending on -- the dynamic width allocated to the sample. biased :: Y biased = Y -> Y -> Y -> Y forall a. (Eq a, Num a) => a -> a -> a -> a Num.scale Y 0.5 Y pos (Y high Y -> Y -> Y forall a. Num a => a -> a -> a - Y low) dynToVel :: Signal.Y -> Int dynToVel :: Y -> Int dynToVel = Int -> Int -> Int -> Int forall a. Ord a => a -> a -> a -> a Num.clamp Int 1 Int 127 (Int -> Int) -> (Y -> Int) -> Y -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Y -> Int forall a b. (RealFrac a, Integral b) => a -> b round (Y -> Int) -> (Y -> Y) -> Y -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (Y -> Y -> Y forall a. Num a => a -> a -> a *Y 127) velToDyn :: Int -> Signal.Y velToDyn :: Int -> Y velToDyn = (Y -> Y -> Y forall a. Fractional a => a -> a -> a /Y 127) (Y -> Y) -> (Int -> Y) -> Int -> Y forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Y forall a b. (Integral a, Num b) => a -> b fromIntegral -- ** envelope dynEnvelope :: Signal.Y -> RealTime.RealTime -> Note.Note -> Signal.Signal dynEnvelope :: Y -> X -> Note -> Signal dynEnvelope Y minDyn X releaseTime Note note = Signal env Signal -> Signal -> Signal forall a. Semigroup a => a -> a -> a <> [(X, Y)] -> Signal forall {k} (kind :: k). [(X, Y)] -> Signal kind Signal.from_pairs [(X end, X -> Signal -> Y forall {k} (kind :: k). X -> Signal kind -> Y Signal.at X end Signal env), (X end X -> X -> X forall a. Num a => a -> a -> a + X releaseTime, Y 0)] where end :: X end = Note -> X Note.end Note note env :: Signal env = Y -> Signal -> Signal forall {k} (kind :: k). Y -> Signal kind -> Signal kind Signal.scalar_scale Y minDyn (Signal -> Signal) -> Signal -> Signal forall a b. (a -> b) -> a -> b $ X -> Signal -> Signal forall {k} (kind :: k). X -> Signal kind -> Signal kind Signal.drop_before (Note -> X Note.start Note note) (Signal -> Signal) -> Signal -> Signal forall a b. (a -> b) -> a -> b $ X -> Signal -> Signal forall {k} (kind :: k). X -> Signal kind -> Signal kind Signal.clip_after (Note -> X Note.end Note note) (Signal -> Signal) -> Signal -> Signal forall a b. (a -> b) -> a -> b $ Signal -> Control -> Map Control Signal -> Signal forall k a. Ord k => a -> k -> Map k a -> a Map.findWithDefault Signal forall a. Monoid a => a mempty Control Control.dynamic (Map Control Signal -> Signal) -> Map Control Signal -> Signal forall a b. (a -> b) -> a -> b $ Note -> Map Control Signal Note.controls Note note -- | Simple sustain-release envelope. sustainRelease :: Signal.Y -> RealTime.RealTime -> Note.Note -> Signal.Signal sustainRelease :: Y -> X -> Note -> Signal sustainRelease Y sustain X releaseTime Note note = [(X, Y)] -> Signal forall {k} (kind :: k). [(X, Y)] -> Signal kind Signal.from_pairs [ (Note -> X Note.start Note note, Y sustain), (Note -> X Note.end Note note, Y sustain) , (Note -> X Note.end Note note X -> X -> X forall a. Num a => a -> a -> a + X releaseTime, Y 0) ] -- * thru thru :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample) -> ImInst.Code thru :: [Char] -> (Note -> ConvertM Sample) -> Code thru [Char] sampleDir Note -> ConvertM Sample convert = ThruFunction -> Code ImInst.thru (ThruFunction -> Code) -> ThruFunction -> Code forall a b. (a -> b) -> a -> b $ [Char] -> (Note -> ConvertM Sample) -> ThruFunction thruFunction [Char] sampleDir Note -> ConvertM Sample convert imThruFunction :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample) -> CUtil.Thru imThruFunction :: [Char] -> (Note -> ConvertM Sample) -> Thru imThruFunction [Char] dir = ThruFunction -> Thru CUtil.ImThru (ThruFunction -> Thru) -> ((Note -> ConvertM Sample) -> ThruFunction) -> (Note -> ConvertM Sample) -> Thru forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> (Note -> ConvertM Sample) -> ThruFunction thruFunction [Char] dir thruFunction :: FilePath -> (Note.Note -> Patch.ConvertM Sample.Sample) -> Thru.ThruFunction thruFunction :: [Char] -> (Note -> ConvertM Sample) -> ThruFunction thruFunction [Char] sampleDir Note -> ConvertM Sample convert = ([Play] -> Message) -> Either Error [Play] -> Either Error Message forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [Play] -> Message Thru.Plays (Either Error [Play] -> Either Error Message) -> ([Note] -> Either Error [Play]) -> ThruFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . (Note -> Either Error Play) -> [Note] -> Either Error [Play] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Note -> Either Error Play note where note :: Note -> Either Error Play note (Thru.Note NoteNumber pitch Y velocity Attributes attrs Int offset) = do (Sample sample, [Msg] _logs) <- ConvertM Sample -> Either Error (Sample, [Msg]) forall a. ConvertM a -> Either Error (a, [Msg]) Patch.runConvert (ConvertM Sample -> Either Error (Sample, [Msg])) -> ConvertM Sample -> Either Error (Sample, [Msg]) forall a b. (a -> b) -> a -> b $ Note -> ConvertM Sample convert (Note -> ConvertM Sample) -> Note -> ConvertM Sample forall a b. (a -> b) -> a -> b $ (Error -> Instrument -> X -> X -> Note Note.note Error "" Instrument "" X 0 X 1) { attributes :: Attributes Note.attributes = Attributes attrs , controls :: Map Control Signal Note.controls = [(Control, Signal)] -> Map Control Signal forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ (Control Control.pitch, Y -> Signal forall {k} (kind :: k). Y -> Signal kind Signal.constant (NoteNumber -> Y Pitch.nn_to_double NoteNumber pitch)) , (Control Control.dynamic, Y -> Signal forall {k} (kind :: k). Y -> Signal kind Signal.constant Y velocity) , (Control Control.sampleStartOffset, Y -> Signal forall {k} (kind :: k). Y -> Signal kind Signal.constant (Int -> Y forall a b. (Integral a, Num b) => a -> b fromIntegral Int offset)) ] } Play -> Either Error Play forall (m :: * -> *) a. Monad m => a -> m a return (Play -> Either Error Play) -> Play -> Either Error Play forall a b. (a -> b) -> a -> b $ [Char] -> Sample -> Play Sample.toThru [Char] sampleDir Sample sample -- * util requireMap :: (Ord k, Show k) => Text -> Map k a -> k -> Patch.ConvertM a requireMap :: forall k a. (Ord k, Show k) => Error -> Map k a -> k -> ConvertM a requireMap Error name Map k a m k k = Error -> Maybe a -> LogT (ExceptT Error Identity) a forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a tryJust (Error "no " Error -> Error -> Error forall a. Semigroup a => a -> a -> a <> Error name Error -> Error -> Error forall a. Semigroup a => a -> a -> a <> Error ": " Error -> Error -> Error forall a. Semigroup a => a -> a -> a <> k -> Error forall a. Show a => a -> Error showt k k) (Maybe a -> LogT (ExceptT Error Identity) a) -> Maybe a -> LogT (ExceptT Error Identity) a forall a b. (a -> b) -> a -> b $ k -> Map k a -> Maybe a forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup k k Map k a m enumAll :: (Enum a, Bounded a) => [a] enumAll :: forall a. (Enum a, Bounded a) => [a] enumAll = [a forall a. Bounded a => a minBound .. a forall a. Bounded a => a maxBound] findBelow :: Ord k => (a -> k) -> k -> [a] -> a findBelow :: forall k a. Ord k => (a -> k) -> k -> [a] -> a findBelow a -> k _ k _ [] = [Char] -> a forall a. HasCallStack => [Char] -> a error [Char] "empty list" findBelow a -> k key k val (a x:[a] xs) = a -> [a] -> a go a x [a] xs where go :: a -> [a] -> a go a x0 (a x:[a] xs) | k val k -> k -> Bool forall a. Ord a => a -> a -> Bool < a -> k key a x = a x0 | Bool otherwise = a -> [a] -> a go a x [a] xs go a x0 [] = a x0 showLower :: Show a => a -> String showLower :: forall a. Show a => a -> [Char] showLower = (Char -> Char) -> ShowS forall a b. (a -> b) -> [a] -> [b] map Char -> Char Char.toLower ShowS -> (a -> [Char]) -> a -> [Char] forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> [Char] forall a. Show a => a -> [Char] show showtLower :: Show a => a -> Text showtLower :: forall a. Show a => a -> Error showtLower = [Char] -> Error txt ([Char] -> Error) -> (a -> [Char]) -> a -> Error forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> [Char] forall a. Show a => a -> [Char] showLower assertLength :: (Stack.HasCallStack, Foldable t) => Int -> t a -> t a assertLength :: forall (t :: * -> *) a. (HasCallStack, Foldable t) => Int -> t a -> t a assertLength Int len t a xs | t a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length t a xs Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int len = t a xs | Bool otherwise = [Char] -> t a forall a. HasCallStack => [Char] -> a error ([Char] -> t a) -> [Char] -> t a forall a b. (a -> b) -> a -> b $ [Char] "expected length " [Char] -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show Int len [Char] -> ShowS forall a. Semigroup a => a -> a -> a <> [Char] ", but was " [Char] -> ShowS forall a. Semigroup a => a -> a -> a <> Int -> [Char] forall a. Show a => a -> [Char] show (t a -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length t a xs)