[Haskell-cafe] Two mysteries
Jeff Clites
jclites at mac.com
Sun Aug 28 17:25:49 UTC 2022
I'm probably just missing something, but in this:
> -- xupdateState
> -- :: (MonadIO m, Ord (StateKey s), State s, State a,
> -- StateValue s ~ StateValue a) =>
> -- s -> (Int -> Int) -> m ()
...
> -- • Could not deduce: StateValue a0 ~ StateValue a
...
> -- The type variable ‘a0’ is ambiguous
`a` is mentioned in the constraint but isn't used in the signature. Is that the problem?
Jeff
> On Aug 28, 2022, at 9:36 AM, Henry Laxen <nadine.and.henry at pobox.com> wrote:
>
>
>
> -- run this with ghci -package microlens-platform -package stm -package containers SC.hs
>
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE AllowAmbiguousTypes #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE TemplateHaskell #-}
>
> module Games.SC where
>
> import qualified Data.Map.Strict as M
> import GHC.IO.Unsafe ( unsafePerformIO )
> import Lens.Micro.Platform
> import Control.Concurrent.STM.TVar
> import Control.Concurrent.STM
> import Control.Monad.IO.Class
>
> type Lenstype f a b = (b -> f b) -> a -> f a
> instance Show a => Show (TVar a) where
> show x = unsafePerformIO $ do
> sx <- readTVarIO x
> return ("TVar: " <> show sx)
>
> newtype TMap k v = TMap (TVar (M.Map k (TVar v))) deriving Show
>
> -- TMap (TVar (Map k (TVar v)))
> -- ^^^^ modify this TVar to add/delete a key
> -- TMap (TVar (Map k (TVar v)))
> -- ^^^^ modify this TVar to change a value
>
> withKey :: (MonadIO m, Ord k) => k -> (Maybe v -> v) -> TMap k v -> m ()
> withKey k f (TMap x) = liftIO $ do
> atomically $ do
> tMap <- readTVar x
> let
> mbK = M.lookup k tMap
> case mbK of -- insert a new (key,value) into the map
> Nothing -> do
> v' <- newTVar (f Nothing)
> let
> newMap = M.insert k v' tMap
> writeTVar x newMap
> Just tv -> do -- modify the value of an existing key
> v' <- readTVar tv
> let newV = f (Just v')
> writeTVar tv newV
> return ()
>
> class State a where
> type StateKey a :: *
> type StateValue a :: *
> lensTmap :: Functor f => Lenstype f a (TMap (StateKey a) (StateValue a))
> lensKey :: Functor f => Lenstype f a (StateKey a)
> lensCounter :: Functor f => Lenstype f (StateValue a) Int
>
> updateState state f = liftIO $ do
> let
> key = state ^. lensKey -- read the key
> mutable = state ^. lensTmap -- find the TVar of the TMap
> withKey key (\(Just x) -> x & lensCounter %~ f) mutable -- update it
>
> -- THE FIRST MYSTERY: If I use the inferred type explicitly for updateState
> -- above, this no longer compiles. I get a "could not deduce" error
> -- reproduced below:
>
> -- xupdateState
> -- :: (MonadIO m, Ord (StateKey s), State s, State a,
> -- StateValue s ~ StateValue a) =>
> -- s -> (Int -> Int) -> m ()
> -- xupdateState state f = liftIO $ do
> -- let
> -- key = state ^. lensKey -- read the key
> -- mutable = state ^. lensTmap -- find the TVar of the TMap
> -- withKey key (\(Just x) -> x & lensCounter %~ f) mutable -- update it
>
> -- /home/henry/nadineloveshenry/projects/nlh/src/Games/SC.hs:84:33-43: error:
> -- • Could not deduce: StateValue a0 ~ StateValue a
> -- from the context: (MonadIO m, Ord (StateKey s), State s, State a,
> -- StateValue s ~ StateValue a)
> -- bound by the type signature for:
> -- xupdateState :: forall (m :: * -> *) s a.
> -- (MonadIO m, Ord (StateKey s), State s, State a,
> -- StateValue s ~ StateValue a) =>
> -- s -> (Int -> Int) -> m ()
> -- at /home/henry/nadineloveshenry/projects/nlh/src/Games/SC.hs:(76,1)-(79,30)
> -- Expected type: ASetter (StateValue a) (StateValue a) Int Int
> -- Actual type: Lenstype
> -- Data.Functor.Identity.Identity (StateValue a0) Int
> -- NB: ‘StateValue’ is a non-injective type family
> -- The type variable ‘a0’ is ambiguous
> -- • In the first argument of ‘(%~)’, namely ‘lensCounter’
> -- In the second argument of ‘(&)’, namely ‘lensCounter %~ f’
> -- In the expression: x & lensCounter %~ f
> -- • Relevant bindings include
> -- x :: StateValue a
> -- (bound at /home/henry/nadineloveshenry/projects/nlh/src/Games/SC.hs:84:23)
> -- mutable :: TMap (StateKey s) (StateValue a)
> -- (bound at /home/henry/nadineloveshenry/projects/nlh/src/Games/SC.hs:83:5)
>
>
> data SampleState = SampleState
> {
> _key :: String
> , _tMap :: TMap String SampleValue
> } deriving Show
>
> data SampleValue = SampleValue
> {
> _counter :: Int
> , _other :: ()
> } deriving Show
>
> $(makeLenses ''SampleState)
> $(makeLenses ''SampleValue)
>
> makeSampleState :: IO SampleState
> makeSampleState = do
> let sampleValue = SampleValue 1 ()
> tvar1 <- newTVarIO sampleValue
> let sampleTMap = M.fromList [("a", tvar1)]
> tvar2 <- newTVarIO sampleTMap
> return (SampleState "a" (TMap tvar2))
>
> -- I can show the result of makeSampleState:
> -- λ> makeSampleState
> -- SampleState {_key = "a", _tMap = TMap TVar: fromList [("a",TVar: SampleValue {_counter = 1, _other = ()})]}
>
> bump1 :: IO ()
> bump1 = do
> xss <- makeSampleState
> let xTmap = xss ^. tMap
> withKey "a" (\(Just x) -> x & counter %~ (+1)) xTmap
> print xTmap
>
> -- Everything here is tickety-boo
> -- λ> bump1
> -- TMap TVar: fromList [("a",TVar: SampleValue {_counter = 2, _other = ()})]
>
> -- Now let's make SampleState an instance of State
>
> instance State SampleState where
> type StateKey SampleState = String
> type StateValue SampleState = SampleValue
> lensTmap = tMap
> lensKey = key
> lensCounter = counter
>
> -- THE SECOND MYSTERY: now lets try bump1 with the type family, but there is no joy
>
> -- bump2 :: IO ()
> -- bump2 = do
> -- xss <- makeSampleState
> -- let xTmap = xss ^. lensTmap
> -- withKey "a" (\(Just x) -> x & lensCounter %~ (+1)) xTmap
> -- print xTmap
>
> -- SC.hs:163:33-43: error:
> -- • Couldn't match type ‘StateValue a0’ with ‘SampleValue’
> -- Expected type: ASetter SampleValue SampleValue Int Int
> -- Actual type: Lenstype
> -- Data.Functor.Identity.Identity (StateValue a0) Int
> -- The type variable ‘a0’ is ambiguous
> -- • In the first argument of ‘(%~)’, namely ‘lensCounter’
> -- In the second argument of ‘(&)’, namely ‘lensCounter %~ (+ 1)’
> -- In the expression: x & lensCounter %~ (+ 1)
>
> -- Can someone please explain what is going on, or point me at a book/paper
> -- Thanks in advance.
>
> -- You can load this into ghci and uncomment to "bad" code to see for
> -- yourself what happens
>
>
>
> --
> Nadine and Henry Laxen The rest is silence
> Gral. Manuel Márquez de León 1301
> Onix #2302
> Zona Urban Rio Never try to teach a pig to sing;
> Tijuana It wastes your time
> +52 (333) 667-8633 And it annoys the pig
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
More information about the Haskell-Cafe
mailing list