Extract Core Functionalities into tidal-core Package

.github/workflows/ci.yml

@@ -77,20 +77,29 @@ jobs:
 
       - name: test
         run: cabal v2-test ${{ matrix.versions.args }} --enable-tests --enable-benchmarks all
-  ormolu:
-    runs-on: ubuntu-latest
-    steps:
-      - uses: actions/checkout@v4
-      - uses: haskell-actions/run-ormolu@v17
-        with:
-          mode: inplace
-          pattern: |
-            src/**/*.hs
-            tidal-link/src/**/*.hs
-            tidal-parse/src/**/*.hs
-            tidal-listener/src/**/*.hs
-      - name: apply ormolu formatting
-        uses: stefanzweifel/git-auto-commit-action@v4
-        if: ${{ always() }}
-        with:
-          commit_message: automated ormolu reformatting
+ormolu:
+  runs-on: ubuntu-latest
+  steps:
+    - uses: actions/checkout@v4
+
+    - name: Detect and switch to current branch
+      run: |
+        BRANCH_NAME=$(git branch --show-current || echo "${{ github.ref_name }}")
+        git checkout "$BRANCH_NAME"
+
+    - uses: haskell-actions/run-ormolu@v17
+      with:
+        mode: inplace
+        pattern: |
+          src/**/*.hs
+          tidal-core/src/**/*.hs
+          tidal-link/src/**/*.hs
+          tidal-parse/src/**/*.hs
+          tidal-listener/src/**/*.hs
+
+    - name: apply ormolu formatting
+      uses: stefanzweifel/git-auto-commit-action@v4
+      if: ${{ always() }}
+      with:
+        commit_message: automated ormolu reformatting
+        branch: ${{ github.head_ref || github.ref_name }}

cabal.project

@@ -1,2 +1,2 @@
 tests: True
-packages: ./ tidal-parse tidal-parse-ffi tidal-listener tidal-link
+packages: ./ tidal-core tidal-parse tidal-parse-ffi tidal-listener tidal-link

flake.nix

@@ -4,6 +4,7 @@
 
     Packages are included for:
     - tidal
+    - tidal-core
     - tidal-link
     - tidal-listener
     - tidal-parse
@@ -45,6 +46,7 @@
       project = pkgs.haskellPackages.extend (pkgs.haskell.lib.compose.packageSourceOverrides {
         hosc = inputs.hosc; # Manually added as `hosc` 0.21 is not yet in nixpkgs.
         tidal = ./.;
+        tidal-core = ./tidal-core;
         tidal-link = ./tidal-link;
         tidal-listener = ./tidal-listener;
         tidal-parse = ./tidal-parse;
@@ -53,6 +55,7 @@
       tidal-ghc = pkgs.haskellPackages.ghcWithPackages (hpkgs: [project.tidal]);
     in {
       tidal = project.tidal;
+      tidal-core = project.tidal-core;
       tidal-link = project.tidal-link;
       tidal-listener = project.tidal-listener;
       tidal-parse = project.tidal-parse;

src/Sound/Tidal/Stream/Process.hs

@@ -43,6 +43,7 @@ import Sound.Tidal.ID
 import qualified Sound.Tidal.Link as Link
 import Sound.Tidal.Params (pS)
 import Sound.Tidal.Pattern
+import Sound.Tidal.Pattern.Types
 import Sound.Tidal.Show ()
 import Sound.Tidal.Stream.Target
 import Sound.Tidal.Stream.Types

src/Sound/Tidal/Stream/Types.hs

@@ -80,7 +80,4 @@ type PlayMap = Map.Map PatId PlayState
 --                     tickArc   :: Arc,
 --                     tickNudge :: Double
 --                    }
---   deriving Show
-
-patternTimeID :: String
-patternTimeID = "_t_pattern"
+--   deriving Show

stack.yaml

@@ -1,13 +1,12 @@
 resolver: lts-22.8
 
 packages:
-  - '.'
-  - 'tidal-parse'
-  - 'tidal-listener'
-  - 'tidal-link'
+  - "."
+  - "tidal-core"
+  - "tidal-parse"
+  - "tidal-listener"
+  - "tidal-link"
 
 extra-deps:
   - hosc-0.21
   - haskellish-0.3.2.2
-
-

test/Test.hs

@@ -1,30 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-import Sound.Tidal.ChordsTest
-import Sound.Tidal.ControlTest
-import Sound.Tidal.CoreTest
-import Sound.Tidal.ExceptionsTest
-import Sound.Tidal.ParamsTest
-import Sound.Tidal.ParseTest
-import Sound.Tidal.PatternTest
-import Sound.Tidal.ScalesTest
-import Sound.Tidal.StepwiseTest
 import Sound.Tidal.StreamTest
-import Sound.Tidal.UITest
-import Sound.Tidal.UtilsTest
 import Test.Microspec
 
 main :: IO ()
 main = microspec $ do
-  Sound.Tidal.CoreTest.run
-  Sound.Tidal.ParseTest.run
-  Sound.Tidal.ParamsTest.run
-  Sound.Tidal.PatternTest.run
-  Sound.Tidal.ControlTest.run
-  Sound.Tidal.ScalesTest.run
-  Sound.Tidal.ChordsTest.run
-  Sound.Tidal.StepwiseTest.run
   Sound.Tidal.StreamTest.run
-  Sound.Tidal.UITest.run
-  Sound.Tidal.UtilsTest.run
-  Sound.Tidal.ExceptionsTest.run

src/Sound/Tidal/Control.hs → tidal-core/src/Sound/Tidal/Control.hs

@@ -43,7 +43,7 @@ import Sound.Tidal.Core
   )
 import qualified Sound.Tidal.Params as P
 import Sound.Tidal.Pattern
-import Sound.Tidal.Stream.Types (patternTimeID)
+import Sound.Tidal.Pattern.Types (patternTimeID)
 import Sound.Tidal.UI (bite, _irand)
 import Prelude hiding ((*>), (<*))
 

tidal-core/src/Sound/Tidal/Pattern/Types.hs

@@ -0,0 +1,4 @@
+module Sound.Tidal.Pattern.Types where
+
+patternTimeID :: String
+patternTimeID = "_t_pattern"

test/Sound/Tidal/CoreTest.hs → tidal-core/test/Sound/Tidal/CoreTest.hs

@@ -5,7 +5,16 @@ module Sound.Tidal.CoreTest where
 import Data.List (sort)
 import qualified Data.Map as Map
 import Data.Ratio
-import Sound.Tidal.Context
+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.Show as C
+import Sound.Tidal.Simple as C
+import Sound.Tidal.Stepwise as C
+import Sound.Tidal.UI as C
 import Test.Microspec
 import TestUtils
 import Prelude hiding ((*>), (<*))

tidal-core/test/Test.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Sound.Tidal.ChordsTest
+import Sound.Tidal.ControlTest
+import Sound.Tidal.CoreTest
+import Sound.Tidal.ExceptionsTest
+import Sound.Tidal.ParamsTest
+import Sound.Tidal.ParseTest
+import Sound.Tidal.PatternTest
+import Sound.Tidal.ScalesTest
+import Sound.Tidal.StepwiseTest
+import Sound.Tidal.UITest
+import Sound.Tidal.UtilsTest
+import Test.Microspec
+
+main :: IO ()
+main = microspec $ do
+  Sound.Tidal.CoreTest.run
+  Sound.Tidal.ParseTest.run
+  Sound.Tidal.ParamsTest.run
+  Sound.Tidal.PatternTest.run
+  Sound.Tidal.ControlTest.run
+  Sound.Tidal.ScalesTest.run
+  Sound.Tidal.ChordsTest.run
+  Sound.Tidal.StepwiseTest.run
+  Sound.Tidal.UITest.run
+  Sound.Tidal.UtilsTest.run
+  Sound.Tidal.ExceptionsTest.run

tidal-core/test/TestUtils.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module TestUtils where
+
+import Data.List (sort)
+import qualified Data.Map.Strict as Map
+import Data.Ratio 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.Show as C
+import Sound.Tidal.Simple as C
+import Sound.Tidal.Stepwise as C
+import Sound.Tidal.UI as C
+import Prelude hiding ((*>), (<*))
+
+import Test.Microspec
+import Prelude hiding ((*>), (<*))
+
+class TolerantEq a where
+  (~==) :: a -> a -> Bool
+
+instance TolerantEq Double where
+  a ~== b = abs (a - b) < 0.000001
+
+instance TolerantEq Value where
+  (VS a) ~== (VS b) = a == b
+  (VI a) ~== (VI b) = a == b
+  (VR a) ~== (VR b) = a == b
+  (VF a) ~== (VF b) = abs (a - b) < 0.000001
+  _ ~== _ = False
+
+instance (TolerantEq a) => TolerantEq [a] where
+  as ~== bs = (length as == length bs) && all (uncurry (~==)) (zip as bs)
+
+instance TolerantEq ValueMap where
+  a ~== b = Map.differenceWith (\a' b' -> if a' ~== b' then Nothing else Just a') a b == Map.empty
+
+instance TolerantEq (Event ValueMap) where
+  (Event _ w p x) ~== (Event _ w' p' x') = w == w' && p == p' && x ~== x'
+
+-- | Compare the events of two patterns using the given arc
+compareP :: (Ord a, Show a) => Arc -> Pattern a -> Pattern a -> Property
+compareP a p p' =
+  sort (queryArc (stripContext p) a)
+    `shouldBe` sort (queryArc (stripContext p') a)
+
+-- | Like @compareP@, but tries to 'defragment' the events
+comparePD :: (Ord a, Show a) => Arc -> Pattern a -> Pattern a -> Property
+comparePD a p p' =
+  sort (defragParts $ queryArc (stripContext p) a)
+    `shouldBe` sort (defragParts $ queryArc (stripContext p') a)
+
+-- | Like @compareP@, but for control patterns, with some tolerance for floating point error
+compareTol :: Arc -> ControlPattern -> ControlPattern -> Bool
+compareTol a p p' = sort (queryArc (stripContext p) a) ~== sort (queryArc (stripContext p') a)
+
+-- | Utility to create a pattern from a String
+ps :: String -> Pattern String
+ps = parseBP_E
+
+stripContext :: Pattern a -> Pattern a
+stripContext = setContext $ Context []
+
+firstCycleValues :: Pattern a -> [a]
+firstCycleValues pat = map value $ queryArc pat (Arc 0 1)

tidal-core/tidal-core.cabal

@@ -0,0 +1,80 @@
+cabal-version: 2.0
+
+name: tidal-core
+version: 1.10.0
+
+homepage: http://tidalcycles.org/
+license: GPL-3
+
+category: Sound
+build-type: Simple
+
+tested-with:
+  GHC == 8.6.5,
+  GHC == 8.8.4,
+  GHC == 8.10.7,
+  GHC == 9.0.2,
+  GHC == 9.4.8,
+  GHC == 9.8.2
+
+library
+  ghc-options: -Wall
+  hs-source-dirs: src
+  default-language: Haskell2010
+
+  exposed-modules:
+    Sound.Tidal.Bjorklund
+    Sound.Tidal.Chords
+    Sound.Tidal.Control
+    Sound.Tidal.Core
+    Sound.Tidal.Params
+    Sound.Tidal.ParseBP
+    Sound.Tidal.Pattern
+    Sound.Tidal.Pattern.Types
+    Sound.Tidal.Scales
+    Sound.Tidal.Show
+    Sound.Tidal.Simple
+    Sound.Tidal.Stepwise
+    Sound.Tidal.Time
+    Sound.Tidal.UI
+    Sound.Tidal.Utils
+
+  build-depends:
+    base >=4.8 && <5,
+    containers <0.8,
+    colour <2.4,
+    text <2.2,
+    parsec >=3.1.12 && <3.2,
+    deepseq >=1.1.0.0
+
+test-suite tests
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  hs-source-dirs: test
+  ghc-options: -Wall
+  default-language: Haskell2010
+
+  other-modules:
+    Sound.Tidal.ControlTest
+    Sound.Tidal.CoreTest
+    Sound.Tidal.ParamsTest
+    Sound.Tidal.ParseTest
+    Sound.Tidal.PatternTest
+    Sound.Tidal.ScalesTest
+    Sound.Tidal.ChordsTest
+    Sound.Tidal.StepwiseTest
+    Sound.Tidal.UITest
+    Sound.Tidal.UtilsTest
+    Sound.Tidal.ExceptionsTest
+    TestUtils
+
+  build-depends:
+    base >=4 && <5,
+    microspec >=0.2.0.1,
+    containers,
+    tidal-core,
+    deepseq
+
+source-repository head
+  type: git
+  location: https://github.com/tidalcycles/Tidal

tidal-listener/tidal-listener.cabal

@@ -26,6 +26,7 @@ library
                        deepseq,
                        optparse-applicative,
                        tidal >= 1.10 && < 1.11,
+                       tidal-core,
                        hosc >= 0.21 && < 0.22,
                        hint,
                        network

tidal-parse-ffi/tidal-parse-ffi.cabal

@@ -19,7 +19,7 @@ library
       base
     , containers
     , tidal-parse 
-    , tidal 
+    , tidal-core 
     , aeson 
     , bytestring 
     , vector
@@ -35,7 +35,7 @@ test-suite tests
     , containers
     , tidal-parse-ffi
     , tidal-parse
-    , tidal
+    , tidal-core
     , aeson
     , bytestring
     , HUnit