{-# LANGUAGE NoMonomorphismRestriction #-}
{-
    Safe/Boot.hs - as in BootTidal but in the Op monad
    Copyright (C) 2021 Johannes Waldmann and contributors

    Forked from:
    https://github.com/jwaldmann/safe-tidal-cli/

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Sound.Tidal.Safe.Boot where

import Sound.Tidal.Safe.Context
import qualified Sound.Tidal.Transition

-- everyone is missing the tidal :: Stream argument
-- this will be provided by the Reader monad

p :: ID -> ControlPattern -> Op ()
p = ID -> ControlPattern -> Op ()
streamReplace

hush :: Op ()
hush = Op ()
streamHush

list :: Op ()
list = Op ()
streamList

mute :: ID -> Op ()
mute = ID -> Op ()
streamMute

unmute :: ID -> Op ()
unmute = ID -> Op ()
streamUnmute

solo :: ID -> Op ()
solo = ID -> Op ()
streamSolo

unsolo :: ID -> Op ()
unsolo = ID -> Op ()
streamUnsolo

once :: ControlPattern -> Op ()
once = ControlPattern -> Op ()
streamOnce

first :: ControlPattern -> Op ()
first = ControlPattern -> Op ()
streamFirst

asap :: ControlPattern -> Op ()
asap = ControlPattern -> Op ()
once

nudgeAll :: Double -> Op ()
nudgeAll = Double -> Op ()
streamNudgeAll

all :: (ControlPattern -> ControlPattern) -> Op ()
all = (ControlPattern -> ControlPattern) -> Op ()
streamAll

-- |
--  Resets the cycle count back to 0.
--  Useful to make sure a pattern or set of patterns start from the beginning:
--
--  > do
--  >   resetCycles
--  >   d1 $ s "bd hh hh hh"
--  >   d2 $ s "ade" # cut 1
--
--  Cycle count affects all patterns, so if there are any active, all of them will immediately jump to the beginning.
--  @resetCycles@ is also userful in multi-user Tidal.
--
--  Also see 'setCycle', 'getnow'.
resetCycles :: Op ()
resetCycles = Op ()
streamResetCycles

-- |
--  Adjusts the number of cycles per second, i.e., tempo.
--  Accepts integers, decimals, and fractions.
--
--  The default number of cycles per second is 0.5625, equivalent to 135\/60\/4, i.e.,
--  135 beats per minute if there are 4 beats per cycle.
--
--  Representing cycles per second using fractions has the advantage of being more
--  human-readable and more closely aligned with how tempo is commonly represented
--  in music as beats per minute (bpm). For example, techno has a typical range of
--  120-140 bpm and house has a range of 115-130 bpm. To set the tempo in Tidal to
--  fast house, e.g.,: @setcps (130\/60\/4)@.
--
--  The following sound the same:
--
--  > setcps (130/60/4)
--  > d1 $ n "1" # s "kick kick kick kick"
--
--  and
--
--  > setcps (130/60/1)
--  > d1 $ n "1" # s "kick"
setcps :: Pattern Double -> Op ()
setcps = ControlPattern -> Op ()
asap (ControlPattern -> Op ())
-> (Pattern Double -> ControlPattern) -> Pattern Double -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern Double -> ControlPattern
cps

-- * Transitions

xfade :: ID -> ControlPattern -> Op ()
xfade ID
i = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
Sound.Tidal.Transition._xfadeIn Time
4) ID
i

xfadeIn :: ID -> Time -> ControlPattern -> Op ()
xfadeIn ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
Sound.Tidal.Transition._xfadeIn Time
t) ID
i

histpan :: ID -> Int -> ControlPattern -> Op ()
histpan ID
i Int
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Int -> TransitionMapper
Sound.Tidal.Transition._histpan Int
t) ID
i

wait :: ID -> Time -> ControlPattern -> Op ()
wait ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
Sound.Tidal.Transition._wait Time
t) ID
i

waitT :: ID -> TransitionMapper -> Time -> ControlPattern -> Op ()
waitT ID
i TransitionMapper
f Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (TransitionMapper -> Time -> TransitionMapper
Sound.Tidal.Transition._waitT TransitionMapper
f Time
t) ID
i

jump :: ID -> ControlPattern -> Op ()
jump ID
i = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (TransitionMapper
Sound.Tidal.Transition._jump) ID
i

jumpIn :: ID -> Int -> ControlPattern -> Op ()
jumpIn ID
i Int
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Int -> TransitionMapper
Sound.Tidal.Transition._jumpIn Int
t) ID
i

jumpIn' :: ID -> Int -> ControlPattern -> Op ()
jumpIn' ID
i Int
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Int -> TransitionMapper
Sound.Tidal.Transition._jumpIn' Int
t) ID
i

jumpMod :: ID -> Int -> ControlPattern -> Op ()
jumpMod ID
i Int
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Int -> TransitionMapper
Sound.Tidal.Transition._jumpMod Int
t) ID
i

mortal :: ID -> Time -> Time -> ControlPattern -> Op ()
mortal ID
i Time
lifespan Time
releaseTime = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> Time -> TransitionMapper
Sound.Tidal.Transition._mortal Time
lifespan Time
releaseTime) ID
i

interpolate :: ID -> ControlPattern -> Op ()
interpolate ID
i = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (TransitionMapper
Sound.Tidal.Transition._interpolate) ID
i

interpolateIn :: ID -> Time -> ControlPattern -> Op ()
interpolateIn ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
Sound.Tidal.Transition._interpolateIn Time
t) ID
i

clutch :: ID -> ControlPattern -> Op ()
clutch ID
i = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (TransitionMapper
forall a. Time -> [Pattern a] -> Pattern a
Sound.Tidal.Transition._clutch) ID
i

clutchIn :: ID -> Time -> ControlPattern -> Op ()
clutchIn ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
forall a. Time -> Time -> [Pattern a] -> Pattern a
Sound.Tidal.Transition._clutchIn Time
t) ID
i

anticipate :: ID -> ControlPattern -> Op ()
anticipate ID
i = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (TransitionMapper
Sound.Tidal.Transition._anticipate) ID
i

anticipateIn :: ID -> Time -> ControlPattern -> Op ()
anticipateIn ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
True (Time -> TransitionMapper
Sound.Tidal.Transition._anticipateIn Time
t) ID
i

forId :: ID -> Time -> ControlPattern -> Op ()
forId ID
i Time
t = Bool -> TransitionMapper -> ID -> ControlPattern -> Op ()
transition Bool
False (Time -> TransitionMapper
forall a. Time -> Time -> [Pattern a] -> Pattern a
Sound.Tidal.Transition._mortalOverlay Time
t) ID
i

d1 :: ControlPattern -> Op ()
d1 = ID -> ControlPattern -> Op ()
p ID
1 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
0)

d2 :: ControlPattern -> Op ()
d2 = ID -> ControlPattern -> Op ()
p ID
2 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
1)

d3 :: ControlPattern -> Op ()
d3 = ID -> ControlPattern -> Op ()
p ID
3 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
2)

d4 :: ControlPattern -> Op ()
d4 = ID -> ControlPattern -> Op ()
p ID
4 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
3)

d5 :: ControlPattern -> Op ()
d5 = ID -> ControlPattern -> Op ()
p ID
5 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
4)

d6 :: ControlPattern -> Op ()
d6 = ID -> ControlPattern -> Op ()
p ID
6 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
5)

d7 :: ControlPattern -> Op ()
d7 = ID -> ControlPattern -> Op ()
p ID
7 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
6)

d8 :: ControlPattern -> Op ()
d8 = ID -> ControlPattern -> Op ()
p ID
8 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
7)

d9 :: ControlPattern -> Op ()
d9 = ID -> ControlPattern -> Op ()
p ID
9 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
8)

d10 :: ControlPattern -> Op ()
d10 = ID -> ControlPattern -> Op ()
p ID
10 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
9)

d11 :: ControlPattern -> Op ()
d11 = ID -> ControlPattern -> Op ()
p ID
11 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
10)

d12 :: ControlPattern -> Op ()
d12 = ID -> ControlPattern -> Op ()
p ID
12 (ControlPattern -> Op ())
-> (ControlPattern -> ControlPattern) -> ControlPattern -> Op ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ControlPattern -> ControlPattern -> ControlPattern
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
|< Pattern Int -> ControlPattern
orbit Pattern Int
11)

d13 :: ControlPattern -> Op ()
d13 = ID -> ControlPattern -> Op ()
p ID
13

d14 :: ControlPattern -> Op ()
d14 = ID -> ControlPattern -> Op ()
p ID
14

d15 :: ControlPattern -> Op ()
d15 = ID -> ControlPattern -> Op ()
p ID
15

d16 :: ControlPattern -> Op ()
d16 = ID -> ControlPattern -> Op ()
p ID
16

setI :: String -> Pattern Int -> Op ()
setI = String -> Pattern Int -> Op ()
streamSetI

setF :: String -> Pattern Double -> Op ()
setF = String -> Pattern Double -> Op ()
streamSetF

setS :: String -> Pattern String -> Op ()
setS = String -> Pattern String -> Op ()
streamSetS

setR :: String -> Pattern Time -> Op ()
setR = String -> Pattern Time -> Op ()
streamSetR

setB :: String -> Pattern Bool -> Op ()
setB = String -> Pattern Bool -> Op ()
streamSetB