diff --git a/.gitignore b/.gitignore index 462b1693c..b9cc66ec5 100644 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,7 @@ out/ .idea/ *.lock *.iml +*.swp # text editor temp files *~ diff --git a/main/Main.hs b/main/Main.hs new file mode 100644 index 000000000..49373c526 --- /dev/null +++ b/main/Main.hs @@ -0,0 +1,137 @@ +{- + Tidal REPL - mimicking ghci + + 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 . +-} + +{-# language PatternSignatures, LambdaCase #-} + +import qualified Language.Haskell.Interpreter as I +import qualified Sound.Tidal.Safe.Context as C +import Control.Monad (void) +import Control.Exception (throw) +import Control.Monad.IO.Class ( MonadIO(liftIO) ) +import Control.Monad.Catch + ( SomeException, MonadCatch(catch), catches, Handler(Handler) ) +-- import qualified Mueval.Resources as MR +import System.Timeout ( timeout ) +import System.IO ( hFlush, stderr, stdout, hPutStrLn, Handle ) +import Data.Char (isSpace) +import Data.List (isPrefixOf) + +main :: IO() +main = do + + -- from BootTidal.hs: + tidal <- C.startTidal + (C.superdirtTarget + { C.oLatency = 0.1, C.oAddress = "127.0.0.1" + , C.oPort = 57120}) + (C.defaultConfig {C.cFrameTimespan = 1/20}) + + void $ I.runInterpreter + $ catch (core tidal) + $ \ (e :: SomeException) -> message stderr $ show e + +core tidal = do + message stdout "safe-tidal-cli starts" + -- more settings at + -- https://github.com/tidalcycles/tidali/blob/master/src/Main.hs + I.set [ I.languageExtensions + I.:= [ I.OverloadedStrings ] + , I.installedModulesInScope I.:= False + ] + I.setImports + [ "Prelude" + , "Sound.Tidal.Safe.Context" + , "Sound.Tidal.Safe.Boot" + ] + -- FIXME: replace lazy IO by some streaming mechanism? + message stdout "safe-tidal-cli has loaded modules" + input <- liftIO getContents + message stdout "safe-tidal-cli has acquired input" + mapM_ (work tidal . unlines) $ blocks $ lines input + message stdout "safe-tidal-cli is done" + +second = 10^6 :: Int + +-- | will show at most 10 lines, at most 80 chars per line, +-- and run (evaluation and print) for at most 1 second +message :: Handle -> String -> I.InterpreterT IO () +message h s = do + let safe = unlines . safe_list 10 ["..."] . map (safe_list 120 "...") . lines + liftIO $ void $ timeout (1 * second) $ do + hPutStrLn h (safe s) ; hFlush h + + +-- | if `length xs <= c`, then `xs`, else `xs <> msg` +safe_list :: Int -> [a] -> [a] -> [a] +safe_list n msg xs = + let (pre,post) = splitAt n xs + in if null post then pre + else pre <> msg + +work :: C.Stream -> String -> I.InterpreterT IO () +work tidal contents = + ( if take 2 contents `elem` [ ":t", ":i", ":d" ] + then do + -- https://github.com/haskell-hint/hint/issues/101 + message stderr $ "not implemented " <> contents + else + I.typeChecksWithDetails contents >>= \ case + Left errs -> throw $ I.WontCompile errs + Right s -> + if s == "Op ()" then do -- execute, print nothing + -- TODO: need timeout for evaluation of pattern: + x <- I.interpret contents (I.as :: C.Op ()) + -- have timeout for execution of pattern: + liftIO $ void $ timeout (1 * second) $ C.exec tidal x + else do -- print type and value + message stdout $ "type : " <> s + if isPrefixOf "IO" s then do + message stderr "cannot show value, will not execute action" + else do + v <- I.eval contents + message stdout $ "value: " <> v + ) + `catches` + [ Handler $ \ (e :: I.InterpreterError) -> + message stderr $ unlines $ case e of + I.UnknownError s -> [ "UnknownError", s ] + I.WontCompile gs -> "WontCompile" : map I.errMsg gs + I.NotAllowed s -> [ "NotAllowed", s ] + I.GhcException s -> [ "GhcException", s ] + , Handler $ \ (e :: SomeException) -> + message stderr $ show e + ] + +-- | Mimicking ghci, where a block is wrapped in `:{` and `:}`, on otherwise empty lines. + +blocks :: [String] -> [[String]] +blocks [] = [] +blocks (":{":ls) = b:(blocks ls') + where (b, ls') = block ls +blocks (l:ls) = [l]:(blocks ls) + +block :: [String] -> ([String], [String]) +block [] = ([],[]) +block (":}":ls) = ([],ls) +block (l:ls) = (l:b, ls') + where (b, ls') = block ls + diff --git a/src/Sound/Tidal/Safe/Boot.hs b/src/Sound/Tidal/Safe/Boot.hs new file mode 100644 index 000000000..e12e29844 --- /dev/null +++ b/src/Sound/Tidal/Safe/Boot.hs @@ -0,0 +1,85 @@ +{- + 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 . +-} + +{-# language NoMonomorphismRestriction #-} + +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 = streamReplace +hush = streamHush +list = streamList +mute = streamMute +unmute = streamUnmute +solo = streamSolo +unsolo = streamUnsolo +once = streamOnce +first = streamFirst +asap = once +nudgeAll = streamNudgeAll +all = streamAll +resetCycles = streamResetCycles +setcps = asap . cps +xfade i = transition True (Sound.Tidal.Transition.xfadeIn 4) i +xfadeIn i t = transition True (Sound.Tidal.Transition.xfadeIn t) i +histpan i t = transition True (Sound.Tidal.Transition.histpan t) i +wait i t = transition True (Sound.Tidal.Transition.wait t) i +waitT i f t = transition True (Sound.Tidal.Transition.waitT f t) i +jump i = transition True (Sound.Tidal.Transition.jump) i +jumpIn i t = transition True (Sound.Tidal.Transition.jumpIn t) i +jumpIn' i t = transition True (Sound.Tidal.Transition.jumpIn' t) i +jumpMod i t = transition True (Sound.Tidal.Transition.jumpMod t) i +mortal i lifespan release = transition True (Sound.Tidal.Transition.mortal lifespan release) i +interpolate i = transition True (Sound.Tidal.Transition.interpolate) i +interpolateIn i t = transition True (Sound.Tidal.Transition.interpolateIn t) i +clutch i = transition True (Sound.Tidal.Transition.clutch) i +clutchIn i t = transition True (Sound.Tidal.Transition.clutchIn t) i +anticipate i = transition True (Sound.Tidal.Transition.anticipate) i +anticipateIn i t = transition True (Sound.Tidal.Transition.anticipateIn t) i +forId i t = transition False (Sound.Tidal.Transition.mortalOverlay t) i + +d1 = p 1 . (|< orbit 0) +d2 = p 2 . (|< orbit 1) +d3 = p 3 . (|< orbit 2) +d4 = p 4 . (|< orbit 3) +d5 = p 5 . (|< orbit 4) +d6 = p 6 . (|< orbit 5) +d7 = p 7 . (|< orbit 6) +d8 = p 8 . (|< orbit 7) +d9 = p 9 . (|< orbit 8) +d10 = p 10 . (|< orbit 9) +d11 = p 11 . (|< orbit 10) +d12 = p 12 . (|< orbit 11) +d13 = p 13 +d14 = p 14 +d15 = p 15 +d16 = p 16 + +setI = streamSetI +setF = streamSetF +setS = streamSetS +setR = streamSetR +setB = streamSetB diff --git a/src/Sound/Tidal/Safe/Context.hs b/src/Sound/Tidal/Safe/Context.hs new file mode 100644 index 000000000..178eb252a --- /dev/null +++ b/src/Sound/Tidal/Safe/Context.hs @@ -0,0 +1,105 @@ +{- + Safe/Context.hs - wraps UI functions + 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 . +-} + +{-# language GeneralizedNewtypeDeriving #-} +{-# language NoMonomorphismRestriction #-} + +module Sound.Tidal.Safe.Context + ( Op () -- do not export constructor, + -- so the user has no way of putting arbitraty IO stuff + -- in "Op", and below "run" + , exec + , streamReplace + , streamHush + , streamList + , streamMute + , streamUnmute + , streamSolo + , streamUnsolo + , streamOnce + , streamFirst + , streamNudgeAll + , streamAll + , streamResetCycles + , streamSetI + , streamSetF + , streamSetS + , streamSetR + , streamSetB + , transition + , module C + , startTidal, superdirtTarget, Target(..) + ) +where + +import Data.Ratio as C +import Sound.Tidal.Carabiner as C +import Sound.Tidal.Config as C +import Sound.Tidal.Control as C +import Sound.Tidal.Core as C +import Sound.Tidal.Params as C +import Sound.Tidal.ParseBP as C +import Sound.Tidal.Pattern as C +import Sound.Tidal.Scales as C +import Sound.Tidal.Simple as C +import Sound.Tidal.Stream + (startTidal, superdirtTarget, Target(..)) +-- import Sound.Tidal.Transition as C +import Sound.Tidal.UI as C +import Sound.Tidal.Version as C +import Sound.Tidal.EspGrid as C + +import qualified Sound.Tidal.Context as C +import Sound.Tidal.Context + (Stream, Pattern, ControlPattern, Time) +import Control.Monad.Reader +import Control.Monad.Catch + +newtype Op r = Op ( ReaderT Stream IO r ) + deriving (Functor, Applicative, Monad, MonadCatch,MonadThrow) + +exec :: Stream -> Op r -> IO r +exec s (Op m) = runReaderT m s + +op1 f = Op $ do a <- ask; lift $ f a +op2 f b = Op $ do a <- ask; lift $ f a b +op3 f b c = Op $ do a <- ask; lift $ f a b c +op4 f b c d = Op $ do a <- ask; lift $ f a b c d +op5 f b c d e = Op $ do a <- ask; lift $ f a b c d e + +streamReplace = op3 C.streamReplace +streamHush = op1 C.streamHush +streamList = op1 C.streamList +streamMute = op2 C.streamMute +streamUnmute = op2 C.streamUnmute +streamSolo = op2 C.streamSolo +streamUnsolo = op2 C.streamUnsolo +streamOnce = op2 C.streamOnce +streamFirst = op2 C.streamFirst +streamNudgeAll = op2 C.streamNudgeAll +streamAll = op2 C.streamAll +streamResetCycles = op1 C.streamResetCycles +transition = op5 C.transition +streamSetI = op3 C.streamSetI +streamSetF = op3 C.streamSetF +streamSetS = op3 C.streamSetS +streamSetR = op3 C.streamSetR +streamSetB = op3 C.streamSetB diff --git a/tidal.cabal b/tidal.cabal index 93919115c..c535d77e4 100644 --- a/tidal.cabal +++ b/tidal.cabal @@ -33,11 +33,14 @@ library Sound.Tidal.Control Sound.Tidal.Context Sound.Tidal.Core + Sound.Tidal.EspGrid Sound.Tidal.ID Sound.Tidal.Params Sound.Tidal.ParseBP Sound.Tidal.Pattern Sound.Tidal.Scales + Sound.Tidal.Safe.Context + Sound.Tidal.Safe.Boot Sound.Tidal.Show Sound.Tidal.Simple Sound.Tidal.Stream @@ -47,7 +50,6 @@ library Sound.Tidal.UI Sound.Tidal.Utils Sound.Tidal.Version - Sound.Tidal.EspGrid Paths_tidal Build-depends: base >=4.8 && <5 @@ -64,7 +66,19 @@ library , deepseq >= 1.1.0.0 , primitive < 0.8 , random < 1.3 + , exceptions < 0.11 + , mtl >= 2.2 +executable tidal + hs-source-dirs: main + main-is: Main.hs + build-depends: base >=4.8 && < 5 + , tidal == 1.7.10 + , hint < 0.10 + , exceptions < 0.11 + , async < 2.3 + default-language: Haskell2010 + test-suite tests type: exitcode-stdio-1.0 main-is: Test.hs