diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for essence-of-live-coding +## 0.2.9 + +* Support GHC 9.12 + ## 0.2.8 * Support GHC 9.10 diff --git a/essence-of-live-coding.cabal b/essence-of-live-coding.cabal --- a/essence-of-live-coding.cabal +++ b/essence-of-live-coding.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.2 name: essence-of-live-coding -version: 0.2.8 +version: 0.2.9 synopsis: General purpose live coding framework description: essence-of-live-coding is a general purpose and type safe live coding framework. @@ -13,7 +14,7 @@ and allows to develop live programs from reusable, modular components. There are also useful utilities for debugging and quickchecking. -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Manuel Bärenz maintainer: programming@manuelbaerenz.de @@ -21,16 +22,16 @@ category: FRP, Live coding build-type: Simple extra-source-files: CHANGELOG.md -cabal-version: >=1.10 tested-with: - GHC == 8.8.4 - GHC == 8.10.7 - GHC == 9.0.2 - GHC == 9.2.8 - GHC == 9.4.8 - GHC == 9.6.5 - GHC == 9.8.2 - GHC == 9.10.1 + GHC == 8.8 + GHC == 8.10 + GHC == 9.0 + GHC == 9.2 + GHC == 9.4 + GHC == 9.6 + GHC == 9.8 + GHC == 9.10 + GHC == 9.12 source-repository head type: git @@ -39,10 +40,19 @@ source-repository this type: git location: https://github.com/turion/essence-of-live-coding.git - tag: v0.2.8 + tag: v0.2.9 +common opts + build-depends: + base >= 4.13 && < 4.22 + , transformers >= 0.5 + , containers >= 0.6 + , syb >= 0.7 + , vector-sized >= 1.2 + , selective >= 0.4 library + import: opts exposed-modules: LiveCoding , LiveCoding.Bind @@ -91,21 +101,16 @@ other-extensions: DeriveDataTypeable build-depends: - base >= 4.13 && < 4.21 - , transformers >= 0.5 - , containers >= 0.6 - , syb >= 0.7 - , vector-sized >= 1.2 - , foreign-store >= 0.2 + foreign-store >= 0.2 , time >= 1.9 , mmorph >= 1.1 , profunctors >= 5.2 - , selective >= 0.4 hs-source-dirs: src default-language: Haskell2010 default-extensions: StrictData test-suite test + import: opts type: exitcode-stdio-1.0 main-is: Main.hs other-modules: @@ -127,26 +132,20 @@ , Util.LiveProgramMigration hs-source-dirs: test build-depends: - base >= 4.13 && < 4.21 - , syb >= 0.7 - , transformers >= 0.5 - , containers >= 0.6 + essence-of-live-coding , mtl >= 2.2 - , essence-of-live-coding , test-framework >= 0.8 , test-framework-quickcheck2 >= 0.3 , QuickCheck >= 2.12 - , selective >= 0.4 , test-framework-hunit >= 0.3 , HUnit >= 1.3 - , vector-sized >= 1.2 default-language: Haskell2010 executable TestExceptions main-is: TestExceptions.hs hs-source-dirs: app build-depends: - base >= 4.13 && < 4.21 + base >= 4.13 && < 4.22 , essence-of-live-coding , transformers >= 0.5 default-language: Haskell2010 @@ -155,7 +154,7 @@ main-is: TestNonBlocking.hs hs-source-dirs: app build-depends: - base >= 4.13 && < 4.21 + base >= 4.13 && < 4.22 , transformers >= 0.5 , essence-of-live-coding default-language: Haskell2010 diff --git a/src/LiveCoding/Cell/NonBlocking.hs b/src/LiveCoding/Cell/NonBlocking.hs --- a/src/LiveCoding/Cell/NonBlocking.hs +++ b/src/LiveCoding/Cell/NonBlocking.hs @@ -54,10 +54,10 @@ noThreadRunning <- if abort then -- Abort the current computation if it is still running - do - maybeThreadId <- tryTakeMVar threadVar - mapM_ killThread maybeThreadId - return True + do + maybeThreadId <- tryTakeMVar threadVar + mapM_ killThread maybeThreadId + return True else -- No computation currently running isEmptyMVar threadVar when noThreadRunning $ do diff --git a/src/LiveCoding/Migrate.lhs b/src/LiveCoding/Migrate.lhs --- a/src/LiveCoding/Migrate.lhs +++ b/src/LiveCoding/Migrate.lhs @@ -18,7 +18,7 @@ import Control.Monad.Trans.State -- syb -import Data.Generics.Aliases +import Data.Generics.Aliases (GenericT, GenericR, GenericT' (..)) import Data.Generics.Twins -- essence-of-live-coding @@ -133,6 +133,8 @@ getChildrenSetters :: Data a => Migration -> a -> [GenericT'] getChildrenSetters specific = gmapQ $ \child -> GT $ flip (runSafeMigration $ treeMigration specific) child +-- This exists in https://hackage-content.haskell.org/package/syb-0.7.3/docs/Data-Generics-Aliases.html#t:GenericR-39- +-- starting at version 0.7.3, migrate eventually newtype GenericR' m = GR { unGR :: GenericR m } getChildrenMaybe :: Data a => a -> [GenericR' Maybe] diff --git a/test/Cell.hs b/test/Cell.hs --- a/test/Cell.hs +++ b/test/Cell.hs @@ -33,9 +33,10 @@ [ testProperty "steps produces outputs" $ \(inputs :: [Int]) -> inputs === fst (runIdentity $ steps (id :: Cell Identity Int Int) inputs) , testProperty "sumC works as expected" $ - forAll (vector 100) $ \(inputs :: [Int]) -> - sum (init inputs) - === last (fst (runIdentity $ steps (sumC :: Cell Identity Int Int) inputs)) + forAll (vector 100) $ + \(inputs :: [Int]) -> + sum (init inputs) + === last (fst (runIdentity $ steps (sumC :: Cell Identity Int Int) inputs)) , Cell.Util.test , Cell.Util.Traversable.testTraverse' , Cell.Monad.Trans.test diff --git a/test/Cell/Util.hs b/test/Cell/Util.hs --- a/test/Cell/Util.hs +++ b/test/Cell/Util.hs @@ -116,7 +116,8 @@ -- Make sure each message arrived exactly once, in order return $ counterexample labelString $ - catMaybes inputs === catMaybes outputs + catMaybes inputs + === catMaybes outputs .||. bufferNotEmpty , testProperty "delay a >>> changes >>> hold a = delay a" $ \(inputs :: [Int]) (startValue :: Int) -> @@ -173,17 +174,18 @@ , output2 = [4, 10, 10, 10] :: [Int] } , testProperty "resampleListPar works as expected" $ - forAll (vector 100) $ \(inputs :: [(Int, Int)]) -> - let - inputs' = fmap pairToList inputs - pairToList :: (a, a) -> [a] - pairToList (x, y) = [x, y] - in - CellSimulation - { cell = resampleListPar (sumC :: Cell Identity Int Int) - , input = inputs' - , output = fmap sum . transpose <$> [[0 :: Int, 0]] : tail (inits (init inputs')) - } + forAll (vector 100) $ + \(inputs :: [(Int, Int)]) -> + let + inputs' = fmap pairToList inputs + pairToList :: (a, a) -> [a] + pairToList (x, y) = [x, y] + in + CellSimulation + { cell = resampleListPar (sumC :: Cell Identity Int Int) + , input = inputs' + , output = fmap sum . transpose <$> [[0 :: Int, 0]] : tail (inits (init inputs')) + } , testProperty "resampleListPar grow" CellSimulation diff --git a/test/Handle.hs b/test/Handle.hs --- a/test/Handle.hs +++ b/test/Handle.hs @@ -70,7 +70,8 @@ cellWithActionParametrized action = flip runStateC 0 $ runHandlingStateC $ - handlingParametrised testParametrisedHandle >>> arrM (<$ lift action) + handlingParametrised testParametrisedHandle + >>> arrM (<$ lift action) throwAfter2Steps :: (Monad m) => Cell (ExceptT () m) a Int throwAfter2Steps = arr (const 1) >>> sumC >>> throwIf_ (> 1) @@ -92,7 +93,8 @@ cellWithActionTypelevel action = flip runStateC 0 $ runHandlingStateC $ - handling testTypelevelHandle >>> arrM (<$ lift action) + handling testTypelevelHandle + >>> arrM (<$ lift action) test = testGroup @@ -122,7 +124,8 @@ CellMigrationSimulation { cell1 = flip runStateC 22 $ - constM (modify (+ 1)) >>> runHandlingStateC (handling testHandle) + constM (modify (+ 1)) + >>> runHandlingStateC (handling testHandle) , cell2 = cellWithAction $ return () , input1 = replicate 3 () , input2 = replicate 3 () @@ -152,7 +155,8 @@ , cell2 = flip runStateC 0 $ runHandlingStateC $ - handling testUnitHandle >>> arr (const "") + handling testUnitHandle + >>> arr (const "") , input1 = replicate 3 () , input2 = replicate 3 () , output1 = ("Handle #0",) <$> replicate 3 0 diff --git a/test/Handle/LiveProgram.hs b/test/Handle/LiveProgram.hs --- a/test/Handle/LiveProgram.hs +++ b/test/Handle/LiveProgram.hs @@ -45,7 +45,9 @@ { liveProgram1 = runHandlingState $ liveCell $ - handling testHandle >>> arrM (lift . tell . return) >>> constM inspectHandlingState + handling testHandle + >>> arrM (lift . tell . return) + >>> constM inspectHandlingState , liveProgram2 = runHandlingState mempty , input1 = replicate 3 () , input2 = replicate 3 () diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -48,9 +48,11 @@ , testGroup "Product types" [ testProperty "Adds default field" $ - Foo1.foo' === migrate Foo1.foo Foo2.foo + Foo1.foo' + === migrate Foo1.foo Foo2.foo , testProperty "Keeps only sensible field" $ - Foo2.foo' === migrate Foo2.foo Foo1.foo + Foo2.foo' + === migrate Foo2.foo Foo1.foo ] , testGroup "Records" @@ -58,7 +60,8 @@ \barA barB barC barC2 barD -> Foo2.Bar {barC = barC2, ..} === migrate Foo2.Bar {barC = barC2, ..} Foo1.Bar {..} , testProperty "Migrates nested records" $ - Foo2.baz' === migrate Foo2.baz Foo1.baz + Foo2.baz' + === migrate Foo2.baz Foo1.baz ] , testGroup "Constructors" @@ -69,12 +72,14 @@ , testProperty "Finds correct constructor if type doesn't change" $ \(x :: Int) -> migrate Nothing (Just x) === Just x , testProperty "Does not migrate for different types" $ - migrate Foo1.same Foo2.similar === Foo1.same + migrate Foo1.same Foo2.similar + === Foo1.same ] , testGroup "User migration" [ testProperty "Can add migration from Int to Integer" $ - Foo2.frob' === migrateWith (userMigration intToInteger) Foo2.frob Foo1.frob + Foo2.frob' + === migrateWith (userMigration intToInteger) Foo2.frob Foo1.frob ] , testGroup "Newtypes" diff --git a/test/Migrate.hs b/test/Migrate.hs --- a/test/Migrate.hs +++ b/test/Migrate.hs @@ -40,20 +40,26 @@ [ testGroup "castMigration" [ testProperty "Migrates for same data type" $ - runSafeMigration castMigration Foo1.same Foo1.same == Foo1.same + runSafeMigration castMigration Foo1.same Foo1.same + == Foo1.same , testProperty "Does not migrate for different data types" $ - runSafeMigration castMigration Foo1.same Foo2.same == Foo1.same + runSafeMigration castMigration Foo1.same Foo2.same + == Foo1.same , testProperty "Migrates for same builtin type" $ - runSafeMigration castMigration (23 :: Int) (42 :: Int) == 42 + runSafeMigration castMigration (23 :: Int) (42 :: Int) + == 42 , testProperty "Does not migrate for different builtin types" $ - runSafeMigration castMigration (23 :: Int) (42 :: Integer) == 23 + runSafeMigration castMigration (23 :: Int) (42 :: Integer) + == 23 ] , testGroup "sameConstructorMigration" [ testProperty "Migrates when constructor names and arity match" $ - runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo2.same == Foo1.same' + runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo2.same + == Foo1.same' , testProperty "Migrates for same data type" $ - runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo1.same' == Foo1.same' + runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo1.same' + == Foo1.same' ] ] , Migrate.NoMigration.test diff --git a/test/Util/LiveProgramMigration.hs b/test/Util/LiveProgramMigration.hs --- a/test/Util/LiveProgramMigration.hs +++ b/test/Util/LiveProgramMigration.hs @@ -7,12 +7,13 @@ import Control.Monad.Trans.RWS.Strict (RWS, runRWS) -- QuickCheck -import Test.QuickCheck -- essence-of-live-coding import LiveCoding +import Test.QuickCheck -data LiveProgramMigration a b = forall s. +data LiveProgramMigration a b + = forall s. LiveProgramMigration { liveProgram1 :: LiveProgram (RWS a b s) , liveProgram2 :: LiveProgram (RWS a b s)