diff --git a/src/Sound/Tidal/Stepwise.hs b/src/Sound/Tidal/Stepwise.hs index be568c29..2ba8fa29 100644 --- a/src/Sound/Tidal/Stepwise.hs +++ b/src/Sound/Tidal/Stepwise.hs @@ -19,14 +19,13 @@ module Sound.Tidal.Stepwise where -import Data.Containers.ListUtils (nubOrd) -import Data.List (sort, transpose) -import Data.Maybe (catMaybes, fromMaybe, isJust) +import Data.List (sort, transpose) +import Data.Maybe (catMaybes, fromMaybe, isJust) import Sound.Tidal.Core import Sound.Tidal.Pattern -import Sound.Tidal.UI (while) -import Sound.Tidal.Utils (applyWhen, pairs) +import Sound.Tidal.UI (while) +import Sound.Tidal.Utils (applyWhen, nubOrd, pairs) _lcmtactus :: [Pattern a] -> Maybe Time _lcmtactus pats = foldl1 lcmr <$> (sequence $ map tactus pats) diff --git a/src/Sound/Tidal/Utils.hs b/src/Sound/Tidal/Utils.hs index 2d745da0..e8f9986f 100644 --- a/src/Sound/Tidal/Utils.hs +++ b/src/Sound/Tidal/Utils.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} + module Sound.Tidal.Utils where {- @@ -21,6 +24,15 @@ module Sound.Tidal.Utils where import Data.List (delete) import System.IO (hPutStrLn, stderr) +import Data.Set (Set) +import qualified Data.Set as Set +-- import qualified Data.IntSet as IntSet +-- import Data.IntSet (IntSet) +#ifdef __GLASGOW_HASKELL__ +import GHC.Exts (build) +#endif + + writeError :: String -> IO () writeError = hPutStrLn stderr @@ -110,3 +122,56 @@ applyWhen False _ x = x -- pair up neighbours in list pairs :: [a] -> [(a,a)] pairs rs = zip rs (tail rs) + +-- The following is from Data.Containers.ListUtils, (c) Gershom Bazerman 2018, +-- Used under a BSD 3-clause license +-- https://hackage.haskell.org/package/containers + +nubOrd :: Ord a => [a] -> [a] +nubOrd = nubOrdOn id + +{-# INLINE nubOrd #-} +nubOrdOn :: Ord b => (a -> b) -> [a] -> [a] +nubOrdOn f = \xs -> nubOrdOnExcluding f Set.empty xs +{-# INLINE nubOrdOn #-} + +nubOrdOnExcluding :: Ord b => (a -> b) -> Set b -> [a] -> [a] +nubOrdOnExcluding f = go + where + go _ [] = [] + go s (x:xs) + | fx `Set.member` s = go s xs + | otherwise = x : go (Set.insert fx s) xs + where !fx = f x + +#ifdef __GLASGOW_HASKELL__ +{-# INLINABLE [1] nubOrdOnExcluding #-} + +{-# RULES +-- Rewrite to a fusible form. +"nubOrdOn" [~1] forall f as s. nubOrdOnExcluding f s as = + build (\c n -> foldr (nubOrdOnFB f c) (constNubOn n) as s) + +-- Rewrite back to a plain form +"nubOrdOnList" [1] forall f as s. + foldr (nubOrdOnFB f (:)) (constNubOn []) as s = + nubOrdOnExcluding f s as + #-} + +nubOrdOnFB :: Ord b + => (a -> b) + -> (a -> r -> r) + -> a + -> (Set b -> r) + -> Set b + -> r +nubOrdOnFB f c x r s + | fx `Set.member` s = r s + | otherwise = x `c` r (Set.insert fx s) + where !fx = f x +{-# INLINABLE [0] nubOrdOnFB #-} + +constNubOn :: a -> b -> a +constNubOn x _ = x +{-# INLINE [0] constNubOn #-} +#endif diff --git a/tidal.cabal b/tidal.cabal index e1279e46..477a8783 100644 --- a/tidal.cabal +++ b/tidal.cabal @@ -58,7 +58,7 @@ library Paths_tidal Build-depends: base >=4.8 && <5 - , containers >= 0.6 && < 0.8 + , containers < 0.8 , colour < 2.4 , hosc >= 0.20 && < 0.21 , text < 2.2