From 0f76b13fab62bfb81d07c891647bfd1f180e42eb Mon Sep 17 00:00:00 2001
From: alex <alex@slab.org>
Date: Mon, 25 Jul 2022 10:24:35 +0100
Subject: [PATCH] Add experimental sequence datatype

---
 src/Sound/Tidal/Common.hs   | 40 +++++++++++++++++++++++
 src/Sound/Tidal/Context.hs  |  4 ++-
 src/Sound/Tidal/Sequence.hs | 64 +++++++++++++++++++++++++++++++++++++
 tidal.cabal                 |  2 ++
 4 files changed, 109 insertions(+), 1 deletion(-)
 create mode 100644 src/Sound/Tidal/Common.hs
 create mode 100644 src/Sound/Tidal/Sequence.hs

diff --git a/src/Sound/Tidal/Common.hs b/src/Sound/Tidal/Common.hs
new file mode 100644
index 000000000..56c05eb9e
--- /dev/null
+++ b/src/Sound/Tidal/Common.hs
@@ -0,0 +1,40 @@
+module Sound.Tidal.Common where
+
+import Sound.Tidal.Pattern as Pat
+import Sound.Tidal.Core as Pat
+-- import Sound.Tidal.UI as Pat
+
+import Sound.Tidal.Sequence as Seq
+
+class Transformable a where
+  rev :: a -> a
+  cat :: [a] -> a
+
+instance Transformable (Pattern a) where
+  rev = Pat.rev
+  cat = Pat.cat
+
+instance Transformable (Branch a) where
+  rev = Seq.rev
+  cat = Seq.cat
+
+seqPat :: Seq.Branch a -> Pat.Pattern a
+seqPat (Seq.Atom _ a) = pure a
+seqPat (Seq.Silence _) = Pat.silence
+seqPat (Seq.Sequence bs) = Pat.timecat $ map (\b -> (seqSpan b, seqPat b)) bs
+seqPat (Seq.Stack Expand bs) = Pat.stack $ map seqPat bs
+seqPat b@(Seq.Stack JustifyLeft bs) =
+  Pat.stack $ map (\b' -> _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs
+seqPat b@(Seq.Stack JustifyRight bs) =
+  Pat.stack $
+    map (\b' -> rotR (1- (1/(seqSpan b / seqSpan b'))) $ _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs
+seqPat b@(Seq.Stack Centre bs) = Pat.stack $
+    map (\b' -> rotR (1.5/(seqSpan b / seqSpan b')) $ _fastGap (seqSpan b / seqSpan b') $ seqPat b') bs
+
+{-
+data Strategy = JustifyBoth
+              | Expand
+              | TruncateMax
+              | TruncateMin
+              | RepeatLCM
+-}
diff --git a/src/Sound/Tidal/Context.hs b/src/Sound/Tidal/Context.hs
index 3d78630f5..71e1268b8 100644
--- a/src/Sound/Tidal/Context.hs
+++ b/src/Sound/Tidal/Context.hs
@@ -22,13 +22,15 @@ import Prelude hiding ((<*), (*>))
 
 import Data.Ratio as C
 
+import Sound.Tidal.Common as C
 import Sound.Tidal.Config as C
 import Sound.Tidal.Control as C
-import Sound.Tidal.Core as C
+import Sound.Tidal.Core as C hiding (rev, cat)
 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.Sequence as C hiding (rev, cat)
 import Sound.Tidal.Show as C
 import Sound.Tidal.Simple as C
 import Sound.Tidal.Stream as C
diff --git a/src/Sound/Tidal/Sequence.hs b/src/Sound/Tidal/Sequence.hs
new file mode 100644
index 000000000..aead882d3
--- /dev/null
+++ b/src/Sound/Tidal/Sequence.hs
@@ -0,0 +1,64 @@
+
+{-
+    Sequence.hs - core representation of Tidal sequences
+    Copyright (C) 2022 Alex McLean and contributors
+
+    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/>.
+-}
+
+module Sound.Tidal.Sequence where
+
+import Prelude hiding (span)
+import Data.Ratio
+
+data Strategy = JustifyLeft
+              | JustifyRight
+              | JustifyBoth
+              | Expand
+              | TruncateMax
+              | TruncateMin
+              | RepeatLCM
+              | Centre
+              deriving Show
+
+data Branch a = Atom Rational a
+              | Silence Rational
+              | Sequence [Branch a]
+              | Stack Strategy [Branch a]
+              deriving Show
+
+rev :: Branch a -> Branch a
+rev (Sequence bs) = Sequence $ reverse $ map rev bs
+rev (Stack strategy bs) = Stack strategy $ map rev bs
+rev b = b
+
+cat :: [Branch a] -> Branch a
+cat [] = Silence 0
+cat [b] = b
+cat bs = Sequence bs
+
+seqSpan :: Branch a -> Rational
+seqSpan (Atom s _) = s
+seqSpan (Silence s) = s
+seqSpan (Sequence bs) = sum $ map seqSpan bs
+seqSpan (Stack _ []) = 0
+seqSpan (Stack RepeatLCM [b]) = seqSpan b
+seqSpan (Stack RepeatLCM (b:bs)) = foldr lcmRational (seqSpan b) $ map seqSpan bs
+seqSpan (Stack TruncateMin (b:bs)) = minimum $ map seqSpan bs
+seqSpan (Stack _ bs) = maximum $ map seqSpan bs
+
+lcmRational a b = (lcm (f a) (f b)) % d
+  where d = lcm (denominator a) (denominator b)
+        f x = numerator x * (d `div` denominator x)
+        
diff --git a/tidal.cabal b/tidal.cabal
index fa9b0026e..9bafeb113 100644
--- a/tidal.cabal
+++ b/tidal.cabal
@@ -29,6 +29,7 @@ library
 
   Exposed-modules:     Sound.Tidal.Bjorklund
                        Sound.Tidal.Chords
+                       Sound.Tidal.Common
                        Sound.Tidal.Config
                        Sound.Tidal.Control
                        Sound.Tidal.Context
@@ -40,6 +41,7 @@ library
                        Sound.Tidal.Scales
                        Sound.Tidal.Safe.Context
                        Sound.Tidal.Safe.Boot
+                       Sound.Tidal.Sequence
                        Sound.Tidal.Show
                        Sound.Tidal.Simple
                        Sound.Tidal.Stream