Import safe-tidal-cli ghci simulator as tidal binary

.gitignore

@@ -16,6 +16,7 @@ out/
 .idea/
 *.lock
 *.iml
+*.swp
 
 # text editor temp files
 *~

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 <http://www.gnu.org/licenses/>.
+-}
+
+{-# 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
+

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 <http://www.gnu.org/licenses/>.
+-}
+
+{-# 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

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 <http://www.gnu.org/licenses/>.
+-}
+
+{-# 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

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