trim typed-transitions dependencies, use QuickCheck 2.12 even on older GHCs, allow STM prior to 2.5

.travis.yml

@@ -13,8 +13,8 @@ after_success:
 - cachix push ouroboros-network ./result-ouroboros-consensus
 matrix:
   include:
-  - name: GHC 862
-    env: COMPILER="ghc862"
+  - name: GHC 844
+    env: COMPILER="ghc844"
 env:
   global:
     secure: WTE6zHkeaOUTYjEImQiZ8/um8H9qf/n+ntUggKmY75EIYC+hzMHof9qvKiFdZ+rzCpU0xKK+OxYlcrKYUH9XjJxo7nEQJ23ez6vbB4qZy5Kf/2r0G+s03PRMuyrRs94Hav0DX1psf659meDtGKMkM1OAmys/ib86TV49uO9zAwwOHjhkjPF/Cnn1X89VyinCQoeh3XOzx7D0CujVJ/5TfTJ9PkMVYwcVeUKj23liUrj8AfyjtHa0fOLpqOQqi6PsTOJ149unecI0Mw8mFOJGDBqHEjBdSn+eEg4ya+ttYNsymzWDJYeQHpetg8g6SXxngu/gjoSrnieZqHHvw/3ZWyqst3GVDLF0xpV8co/XdS+v8D9kVRZSvY38Yw3mJLw6L39D9ZF7NBkSZou4FhOuDcqqw1OnesUO4K1OLd50UDoJKIcThdNQyUDmGNfj1eypq69tSwSCMZRRBVLAQOAFfXAM3oTapcGkwJ/1pRbUFG5pQfdIxM2eD800mTdWq7NOb73RZM8EQ2T5B3NMKx2ViGgXgrIx1PcknhSE1gcxDC5Gjb4n1GkO7493JOvs1R05Ewjpj7q29xBeir9e4DRSNZh3JKw48U9ZZCthMmmRq5ItleHUHiS4D2+tOVKnFKleBqg3IEmzfWTDWii+hkLJy2XpeBf4Axqpe5jzk+VmqTU=

nix/nixpkgs.nix

@@ -1,7 +1,7 @@
 {}:
 with builtins;
 let
-  rev = "cb95a3c1d1b6cd9da65650be269436cbe9e265fa";
+  rev = "475d653afdbd8fe3e00ccfd22a30014b0df7aeaa";
   url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
 
   config = { packageOverrides = super:
@@ -10,6 +10,12 @@ let
           overrides = self: super:
             { psqueues = lib.dontCheck super.psqueues;
               aeson    = lib.dontCheck super.aeson;
+              QuickCheck = super.QuickCheck_2_12_6_1;
+              hspec = super.hspec_2_6_0;
+              hspec-core = super.hspec-core_2_6_0;
+              hspec-discover = super.hspec-discover_2_6_0;
+              hspec-meta = super.hspec-meta_2_6_0;
+              tasty-hspec = super.tasty-hspec_1_1_5_1;
             };
       in {
         haskell = super.haskell // {

ouroboros-network/ouroboros-network.cabal

@@ -98,16 +98,16 @@ library
                        bytestring        >=0.10 && <0.11,
                        cborg             >=0.2.1 && <0.3,
                        clock             >=0.7 && <0.8,
-                       containers        >=0.6 && <0.7,
-                       free              >=5.1 && <5.2,
+                       containers,
+                       free,
                        hashable          >=1.2 && <1.3,
                        mtl               >=2.2 && <2.3,
                        network,
                        pipes             >=4.3 && <4.4,
                        process           >=1.6 && <1.7,
                        psqueues          >=0.2 && <0.3,
                        serialise         >=0.2 && <0.3,
-                       stm               >=2.5 && <2.6,
+                       stm               >=2.4 && <2.6,
                        text              >=1.2 && <1.3,
 
                        QuickCheck        >=2.12 && <2.13

ouroboros-network/src/Ouroboros/Network/MonadClass/MonadSTM.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE CPP                    #-}
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 module Ouroboros.Network.MonadClass.MonadSTM
   ( MonadSTM (..)
@@ -88,8 +89,9 @@ class (MonadFork m, Monad (Tr m)) => MonadSTM m where
   newTBQueue     :: Natural -> Tr m (TBQueue m a)
   readTBQueue    :: TBQueue m a -> Tr m a
   writeTBQueue   :: TBQueue m a -> a -> Tr m ()
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue  :: TBQueue m a -> Tr m Natural
-
+#endif
 
 instance MonadFork m => MonadFork (ReaderT e m) where
   fork (ReaderT f) = ReaderT $ \e -> fork (f e)
@@ -122,7 +124,9 @@ instance MonadSTM m => MonadSTM (ReaderT e m) where
   newTBQueue       = lift . newTBQueue
   readTBQueue      = lift . readTBQueue
   writeTBQueue q a = lift $ writeTBQueue q a
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue    = lift . lengthTBQueue
+#endif
 
 -- NOTE(adn): Is this a sensible instance?
 instance (Show e, MonadFork m) => MonadFork (ExceptT e m) where
@@ -156,8 +160,9 @@ instance (Show e, MonadSTM m) => MonadSTM (ExceptT e m) where
   newTBQueue       = lift . newTBQueue
   readTBQueue      = lift . readTBQueue
   writeTBQueue q a = lift $ writeTBQueue q a
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue    = lift . lengthTBQueue
-
+#endif
 
 --
 -- Instance for IO uses the existing STM library implementations
@@ -195,10 +200,17 @@ instance MonadSTM IO where
 
   type TBQueue IO = STM.TBQueue
 
+#if MIN_VERSION_stm(2,5,0)
   newTBQueue     = STM.newTBQueue
+#else
+  -- STM prior to 2.5.0 takes an Int
+  newTBQueue     = STM.newTBQueue . fromEnum
+#endif
   readTBQueue    = STM.readTBQueue
   writeTBQueue   = STM.writeTBQueue
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue  = STM.lengthTBQueue
+#endif
 
 --
 -- Default TMVar implementation in terms of TVars (used by sim)

ouroboros-network/src/Ouroboros/Network/Sim.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE CPP                        #-}
 
 module Ouroboros.Network.Sim {-(
   SimF,
@@ -154,7 +155,9 @@ instance MonadSTM (Free (SimF s)) where
   newTBQueue        = newTBQueueDefault
   readTBQueue       = readTBQueueDefault
   writeTBQueue      = writeTBQueueDefault
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue     = lengthTBQueueDefault
+#endif
 
 instance MonadST (Free (SimF s)) where
   withLiftST f = f liftST

typed-transitions/default.nix

@@ -1,14 +1,14 @@
-{ mkDerivation, async, base, bytestring, free, QuickCheck, stdenv
-, tasty, tasty-quickcheck, text, transformers, nixpkgs
+{ mkDerivation, async, base, bytestring, QuickCheck, stdenv, tasty
+, tasty-quickcheck, nixpkgs
 }:
 mkDerivation {
   pname = "typed-transitions";
   version = "0.1.0.0";
   src = nixpkgs.lib.sourceFilesBySuffices ./.
     [ ".hs" "LICENSE" "typed-transitions.cabal" ];
-  libraryHaskellDepends = [ async base free text transformers ];
+  libraryHaskellDepends = [ base ];
   testHaskellDepends = [
-    async base bytestring QuickCheck tasty tasty-quickcheck text
+    async base bytestring QuickCheck tasty tasty-quickcheck
   ];
   license = stdenv.lib.licenses.bsd3;
   enableSeparateDocOutput = false;

typed-transitions/src/Protocol/PingPong/Codec.hs

@@ -6,13 +6,11 @@
 
 module Protocol.PingPong.Codec where
 
-import Data.Text (Text, pack)
-
 import Protocol.Codec
 
 import Protocol.PingPong.Type
 
-pingPongCodec :: Monad m => Codec m Text String String PingPongMessage 'StIdle
+pingPongCodec :: Monad m => Codec m String String String PingPongMessage 'StIdle
 pingPongCodec = pingPongCodecIdle
 
 -- | Here is a complete codec for the ping/pong protocol at 'StIdle.
@@ -33,7 +31,7 @@ pingPongCodec = pingPongCodecIdle
 --   TrGood :: Transition ('Idle param) ('Busy param)
 --
 --
-pingPongCodecIdle :: Monad m => Codec m Text String String PingPongMessage 'StIdle
+pingPongCodecIdle :: Monad m => Codec m String String String PingPongMessage 'StIdle
 pingPongCodecIdle = Codec
   { encode = Encoder $ \tr -> case tr of
       MsgPing -> Encoded "ping" pingPongCodecBusy
@@ -42,37 +40,37 @@ pingPongCodecIdle = Codec
   }
   where
   decodeIdle acc = Fold $ pure $ Partial $ Response
-    { end  = pure $ Left (pack "expected ping or done")
+    { end  = pure $ Left "expected ping or done"
     , more = \strs ->
         let str = mconcat strs
         in  if length acc + length str < 4
             then decodeIdle (acc ++ str)
             else Fold $ pure $ Complete [drop 4 (acc ++ str)] $ pure $ case take 4 (acc ++ str) of
               "ping" -> Right $ Decoded MsgPing pingPongCodecBusy
               "done" -> Right $ Decoded MsgDone pingPongCodecDone
-              _      -> Left  $ pack "expected ping"
+              _      -> Left    "expected ping"
     }
 
-pingPongCodecBusy :: Monad m => Codec m Text String String PingPongMessage 'StBusy
+pingPongCodecBusy :: Monad m => Codec m String String String PingPongMessage 'StBusy
 pingPongCodecBusy = Codec
   { encode = Encoder $ \tr -> case tr of
       MsgPong -> Encoded "pong" pingPongCodecIdle
   , decode = decodePong ""
   }
   where
   decodePong acc = Fold $ pure $ Partial $ Response
-    { end  = pure $ Left (pack "expected pong")
+    { end  = pure $ Left "expected pong"
     , more = \strs ->
         let str = mconcat strs
         in if length acc + length str < 4
            then decodePong (acc ++ str)
            else Fold $ pure $ Complete [drop 4 (acc ++ str)] $ pure $ case take 4 (acc ++ str) of
              "pong" -> Right $ Decoded MsgPong pingPongCodecIdle
-             _      -> Left  $ pack "expected pong"
+             _      -> Left    "expected pong"
     }
 
-pingPongCodecDone :: Monad m => Codec m Text String String PingPongMessage 'StDone
+pingPongCodecDone :: Monad m => Codec m String String String PingPongMessage 'StDone
 pingPongCodecDone = Codec
   { encode = Encoder $ \tr -> case tr of { }
-  , decode = Fold $ pure $ Complete [] $ pure $ Left $ pack "done"
+  , decode = Fold $ pure $ Complete [] $ pure $ Left "done"
   }

typed-transitions/src/Protocol/PingPong/Examples.hs

@@ -2,12 +2,10 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes          #-}
 
 module Protocol.PingPong.Examples where
 
-import           Control.Concurrent.Async
-import           Data.Text (unpack)
-
 import           Protocol.Channel (mvarChannels)
 import           Protocol.Driver
 import           Protocol.PingPong.Server
@@ -52,16 +50,16 @@ pingPongClientCount n = SendMsgPing (pure (pingPongClientCount (n-1)))
 -- | Client and server run concurrently, communcating via an MVar channel.
 -- The input is how many pings to send, the output is how many the server has
 -- received when it finishes. We'll find they're always equal.
-demoCodec :: Int -> IO Int
-demoCodec n = do
+demoCodec :: (forall a b . IO a -> IO b -> IO (a,b)) -> Int -> IO Int
+demoCodec concurrently n = do
   (clientChannel, serverChannel) <- mvarChannels
   let clientPeer = pingPongClientPeer (pingPongClientCount n)
       serverPeer = pingPongServerPeer (pingPongServerCounting 0)
       -- Here we eliminate the 'Result' from the server and client by
       -- throwing an error, so that if one dies, the other doesn't starve,
       -- but also dies with unexpected end of input.
       throwOnUnexpected (Normal t) = pure t
-      throwOnUnexpected (Unexpected text) = error (unpack text)
+      throwOnUnexpected (Unexpected str) = error str
       client = throwOnUnexpected =<< useCodecWithDuplex clientChannel pingPongCodec clientPeer
       server = throwOnUnexpected =<< useCodecWithDuplex serverChannel pingPongCodec serverPeer
   ((), m) <- concurrently client server

typed-transitions/test/Test/Protocol/Codec/PingPong.hs

@@ -8,7 +8,6 @@ module Test.Protocol.Codec.PingPong where
 
 import Data.Functor.Identity (runIdentity)
 import Data.Type.Equality
-import Data.Text (Text, pack)
 
 import Test.QuickCheck
 import Test.Tasty (TestTree, testGroup)
@@ -56,7 +55,7 @@ prop_ping_pong_coherent = forAllShow genPath showPath doTest
   eqTr MsgDone MsgDone = Just Refl
   eqTr _       _       = Nothing
 
-  decodeFull :: Monad m => String -> Decoder Text String m x -> m (Either Text x)
+  decodeFull :: Monad m => String -> Decoder String String m x -> m (Either String x)
   decodeFull str decoder = do
     (it, remaining) <- foldOverInput decoder (singletonInput [str])
     case remaining of
@@ -66,7 +65,7 @@ prop_ping_pong_coherent = forAllShow genPath showPath doTest
       -- we mconcat it twice to get the entire remaining input as a String.
       Just input -> drainInput input >>= \lst -> case mconcat (mconcat lst) of
         []    -> pure it
-        bad@(_ : _) -> pure $ Left $ pack $ "decoder did not use all of its input: " ++ bad
+        bad@(_ : _) -> pure $ Left $ "decoder did not use all of its input: " ++ bad
 
 tests :: TestTree
 tests = testGroup "PingPong"

typed-transitions/typed-transitions.cabal

@@ -43,11 +43,7 @@ library
                      , TypeOperators
                      , BangPatterns
                      , StandaloneDeriving
-  build-depends:       base >=4.9 && <4.13
-                     , async
-                     , transformers >=0.5 && <0.6
-                     , free >=5.1 && <5.2
-                     , text
+  build-depends:       base
 
   hs-source-dirs:      src
   default-language:    Haskell2010
@@ -63,13 +59,11 @@ test-suite test-typed-transitions
                     Test.Protocol.Codec
                     Test.Protocol.Codec.Coherent
                     Test.Protocol.Codec.PingPong
-  build-depends:    base >=4.9 && <4.13
+  build-depends:    base
                   , async
                   , bytestring
-                  , QuickCheck >=2.12 && <2.13
+                  , QuickCheck
                   , tasty
                   , tasty-quickcheck
-                  , text
-                  , transformers
                   , typed-transitions
   ghc-options:    -rtsopts