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