From c6ef650891c6466619dacab7a9f921fc16952821 Mon Sep 17 00:00:00 2001 From: Matthew Kaney Date: Thu, 18 Apr 2024 20:09:34 -0400 Subject: [PATCH] Revert "Apply stylish-haskell formatting" This reverts commit 491bd1b118e107762ba0277144092ea964c7ef23, reversing changes made to 9eca1d63c30ab09a6d4d05f762b612ba1a47ed8e. --- src/Sound/Tidal/Stream/Process.hs | 99 +++++++++++++++---------------- src/Sound/Tidal/Stream/Types.hs | 54 ++++++++--------- src/Sound/Tidal/Stream/UI.hs | 25 ++++---- 3 files changed, 86 insertions(+), 92 deletions(-) diff --git a/src/Sound/Tidal/Stream/Process.hs b/src/Sound/Tidal/Stream/Process.hs index b002eb68..7c295edc 100644 --- a/src/Sound/Tidal/Stream/Process.hs +++ b/src/Sound/Tidal/Stream/Process.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, FlexibleContexts, ScopedTypeVariables, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# language DeriveGeneric, StandaloneDeriving #-} module Sound.Tidal.Stream.Process where @@ -27,43 +22,43 @@ module Sound.Tidal.Stream.Process where along with this library. If not, see . -} -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>)) import Control.Concurrent.MVar -import qualified Control.Exception as E -import Control.Monad (forM_, when) -import Data.Coerce (coerce) -import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromJust, fromMaybe) +import Control.Monad (forM_, when) +import Data.Coerce (coerce) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromJust, fromMaybe, catMaybes) +import qualified Control.Exception as E import Foreign.C.Types -import System.IO (hPutStrLn, stderr) +import System.IO (hPutStrLn, stderr) -import qualified Sound.Osc.Fd as O +import qualified Sound.Osc.Fd as O -import Data.List (sortOn) -import qualified Sound.Tidal.Clock as Clock -import Sound.Tidal.Core (stack, (#)) +import Sound.Tidal.Stream.Config +import Sound.Tidal.Core (stack, (#)) import Sound.Tidal.ID -import qualified Sound.Tidal.Link as Link -import Sound.Tidal.Params (pS) +import qualified Sound.Tidal.Link as Link +import qualified Sound.Tidal.Clock as Clock +import Sound.Tidal.Params (pS) import Sound.Tidal.Pattern -import Sound.Tidal.Show () -import Sound.Tidal.Stream.Config -import Sound.Tidal.Utils ((!!!)) +import Sound.Tidal.Utils ((!!!)) +import Data.List (sortOn) +import Sound.Tidal.Show () -import Sound.Tidal.Stream.Target import Sound.Tidal.Stream.Types +import Sound.Tidal.Stream.Target data ProcessedEvent = ProcessedEvent { - peHasOnset :: Bool, - peEvent :: Event ValueMap, - peCps :: Link.BPM, - peDelta :: Link.Micros, - peCycle :: Time, - peOnWholeOrPart :: Link.Micros, + peHasOnset :: Bool, + peEvent :: Event ValueMap, + peCps :: Link.BPM, + peDelta :: Link.Micros, + peCycle :: Time, + peOnWholeOrPart :: Link.Micros, peOnWholeOrPartOsc :: O.Time, - peOnPart :: Link.Micros, - peOnPartOsc :: O.Time + peOnPart :: Link.Micros, + peOnPartOsc :: O.Time } -- | Query the current pattern (contained in argument @stream :: Stream@) @@ -112,7 +107,7 @@ doTick stateMV playMV globalFMV cxs (st,end) nudge ops = tes <- processCps ops es' -- For each OSC target forM_ cxs $ \cx@(Cx target _ oscs _ _ bussesMV) -> do - busses <- mapM readMVar bussesMV + busses <- mapM readMVar bussesMV -- Latency is configurable per target. -- Latency is only used when sending events live. let latency = oLatency target @@ -230,15 +225,15 @@ toData (OSC {args = Named rqrd}) e toData _ _ = Nothing toDatum :: Value -> O.Datum -toDatum (VF x) = O.float x -toDatum (VN x) = O.float x -toDatum (VI x) = O.int32 x -toDatum (VS x) = O.string x -toDatum (VR x) = O.float $ ((fromRational x) :: Double) -toDatum (VB True) = O.int32 (1 :: Int) +toDatum (VF x) = O.float x +toDatum (VN x) = O.float x +toDatum (VI x) = O.int32 x +toDatum (VS x) = O.string x +toDatum (VR x) = O.float $ ((fromRational x) :: Double) +toDatum (VB True) = O.int32 (1 :: Int) toDatum (VB False) = O.int32 (0 :: Int) -toDatum (VX xs) = O.Blob $ O.blob_pack xs -toDatum _ = error "toDatum: unhandled value" +toDatum (VX xs) = O.Blob $ O.blob_pack xs +toDatum _ = error "toDatum: unhandled value" substitutePath :: String -> ValueMap -> Maybe String substitutePath str cm = parse str @@ -256,19 +251,19 @@ getString :: ValueMap -> String -> Maybe String getString cm s = (simpleShow <$> Map.lookup param cm) <|> defaultValue dflt where (param, dflt) = break (== '=') s simpleShow :: Value -> String - simpleShow (VS str) = str - simpleShow (VI i) = show i - simpleShow (VF f) = show f - simpleShow (VN n) = show n - simpleShow (VR r) = show r - simpleShow (VB b) = show b - simpleShow (VX xs) = show xs - simpleShow (VState _) = show "" + simpleShow (VS str) = str + simpleShow (VI i) = show i + simpleShow (VF f) = show f + simpleShow (VN n) = show n + simpleShow (VR r) = show r + simpleShow (VB b) = show b + simpleShow (VX xs) = show xs + simpleShow (VState _) = show "" simpleShow (VPattern _) = show "" - simpleShow (VList _) = show "" + simpleShow (VList _) = show "" defaultValue :: String -> Maybe String defaultValue ('=':dfltVal) = Just dfltVal - defaultValue _ = Nothing + defaultValue _ = Nothing playStack :: PlayMap -> ControlPattern playStack pMap = stack . (map pattern) . (filter active) . Map.elems $ pMap @@ -318,5 +313,5 @@ setPreviousPatternOrSilence playMV = modifyMVar_ playMV $ return . Map.map ( \ pMap -> case history pMap of _:p:ps -> pMap { pattern = p, history = p:ps } - _ -> pMap { pattern = silence, history = [silence] } + _ -> pMap { pattern = silence, history = [silence] } ) diff --git a/src/Sound/Tidal/Stream/Types.hs b/src/Sound/Tidal/Stream/Types.hs index 9189ab41..74db70f4 100644 --- a/src/Sound/Tidal/Stream/Types.hs +++ b/src/Sound/Tidal/Stream/Types.hs @@ -1,33 +1,33 @@ module Sound.Tidal.Stream.Types where import Control.Concurrent.MVar -import qualified Data.Map.Strict as Map -import Sound.Tidal.Pattern -import Sound.Tidal.Show () +import qualified Data.Map.Strict as Map +import Sound.Tidal.Pattern +import Sound.Tidal.Show () -import qualified Network.Socket as N -import qualified Sound.Osc.Fd as O +import qualified Sound.Osc.Fd as O +import qualified Network.Socket as N -import qualified Sound.Tidal.Clock as Clock +import qualified Sound.Tidal.Clock as Clock -import Sound.Tidal.Stream.Config +import Sound.Tidal.Stream.Config -data Stream = Stream {sConfig :: Config, - sStateMV :: MVar ValueMap, +data Stream = Stream {sConfig :: Config, + sStateMV :: MVar ValueMap, -- sOutput :: MVar ControlPattern, - sClockRef :: Clock.ClockRef, - sListen :: Maybe O.Udp, - sPMapMV :: MVar PlayMap, + sClockRef :: Clock.ClockRef, + sListen :: Maybe O.Udp, + sPMapMV :: MVar PlayMap, sGlobalFMV :: MVar (ControlPattern -> ControlPattern), - sCxs :: [Cx] + sCxs :: [Cx] } -data Cx = Cx {cxTarget :: Target, - cxUDP :: O.Udp, - cxOSCs :: [OSC], - cxAddr :: N.AddrInfo, +data Cx = Cx {cxTarget :: Target, + cxUDP :: O.Udp, + cxOSCs :: [OSC], + cxAddr :: N.AddrInfo, cxBusAddr :: Maybe N.AddrInfo, - cxBusses :: Maybe (MVar [Int]) + cxBusses :: Maybe (MVar [Int]) } data StampStyle = BundleStamp @@ -38,13 +38,13 @@ data Schedule = Pre StampStyle | Live deriving (Eq, Show) -data Target = Target {oName :: String, - oAddress :: String, - oPort :: Int, - oBusPort :: Maybe Int, - oLatency :: Double, - oWindow :: Maybe Arc, - oSchedule :: Schedule, +data Target = Target {oName :: String, + oAddress :: String, + oPort :: Int, + oBusPort :: Maybe Int, + oLatency :: Double, + oWindow :: Maybe Arc, + oSchedule :: Schedule, oHandshake :: Bool } deriving Show @@ -60,8 +60,8 @@ data OSC = OSC {path :: String, deriving Show data PlayState = PlayState {pattern :: ControlPattern, - mute :: Bool, - solo :: Bool, + mute :: Bool, + solo :: Bool, history :: [ControlPattern] } deriving Show diff --git a/src/Sound/Tidal/Stream/UI.hs b/src/Sound/Tidal/Stream/UI.hs index cc015814..3df86126 100644 --- a/src/Sound/Tidal/Stream/UI.hs +++ b/src/Sound/Tidal/Stream/UI.hs @@ -1,20 +1,19 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} module Sound.Tidal.Stream.UI where +import qualified Data.Map as Map +import qualified Control.Exception as E import Control.Concurrent.MVar -import qualified Control.Exception as E -import qualified Data.Map as Map -import System.IO (hPutStrLn, stderr) -import System.Random (getStdRandom, randomR) +import System.IO (hPutStrLn, stderr) +import System.Random (getStdRandom, randomR) -import qualified Sound.Tidal.Clock as Clock +import qualified Sound.Tidal.Clock as Clock +import Sound.Tidal.Stream.Types import Sound.Tidal.Stream.Config import Sound.Tidal.Stream.Process -import Sound.Tidal.Stream.Types -import Sound.Tidal.ID import Sound.Tidal.Pattern +import Sound.Tidal.ID streamNudgeAll :: Stream -> Double -> IO () streamNudgeAll s = Clock.setNudge (sClockRef s) @@ -51,10 +50,10 @@ streamList s = do pMap <- readMVar (sPMapMV s) let hs = hasSolo pMap putStrLn $ concatMap (showKV hs) $ Map.toList pMap where showKV :: Bool -> (PatId, PlayState) -> String - showKV True (k, (PlayState {solo = True})) = k ++ " - solo\n" - showKV True (k, _) = "(" ++ k ++ ")\n" + showKV True (k, (PlayState {solo = True})) = k ++ " - solo\n" + showKV True (k, _) = "(" ++ k ++ ")\n" showKV False (k, (PlayState {solo = False})) = k ++ "\n" - showKV False (k, _) = "(" ++ k ++ ") - muted\n" + showKV False (k, _) = "(" ++ k ++ ") - muted\n" streamReplace :: Stream -> ID -> ControlPattern -> IO () streamReplace stream k !pat = do @@ -138,4 +137,4 @@ streamSetB :: Stream -> String -> Pattern Bool -> IO () streamSetB = streamSet streamSetR :: Stream -> String -> Pattern Rational -> IO () -streamSetR = streamSet +streamSetR = streamSet \ No newline at end of file