[GHC] #9607: Programs that require AllowAmbiguousTypes in 7.8
GHC
ghc-devs at haskell.org
Tue Feb 24 16:51:18 UTC 2015
#9607: Programs that require AllowAmbiguousTypes in 7.8
-------------------------------------+-------------------------------------
Reporter: jstolarek | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler (Type | Version: 7.8.3
checker) | Keywords:
Resolution: | Architecture:
Operating System: Unknown/Multiple | Unknown/Multiple
Type of failure: GHC rejects | Test Case:
valid program | Blocking:
Blocked By: | Differential Revisions:
Related Tickets: |
-------------------------------------+-------------------------------------
Comment (by trevorcook):
My apologies if I am off base, but I think I have an example.
I'm making a visualization server that handles the rendering of 3d*
graphics. The server listens for messages regarding "entity" primitives
and current point of view. For every entity it adds it handshakes to the
client with a unique id, so that the client can update the entity if
needed. The basic service deals with primitive shapes, and the idea is to
develop client services which can translate between higher level
abstractions and the visualization primitives. For example, a plotting
utility might be a client which exposes an "axes" primitive, which in turn
relates to a set of visualization primitives used for tic marks, axis
lines, and labels.
I'm organizing the architecture to be based on the below Client and Server
type classes. Clients create commands and further processing based on the
responses to the commands. Servers listen to commands, do something, and
eventually return responses. The classes attempt to separate out the key
protocol/visualization components from the actual implementation. The
forwarding action below pastes together clients and servers, and will
hopefully be reusable for making concrete services based on different
messaging technologies, and for implementations for different
visualization domains. It seems to require AmbiguousTypes, though I don't
understand why.
{{{#!haskell
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module CSFwd where
import VisServ.Base
import Data.Monoid (mconcat,Monoid)
-- | Imported from VisServ.Base
--type family ComResp cmd
-- |triggered by some data, trig, a client request yields a list of
commands, cmd,
-- and functions which consume the resulting response.
class ClientAction cmd trig a where
clientRequest :: trig -> [(cmd, ComResp cmd -> a)]
-- |triggered by some command, cmd, a server does some reaction, react,
and
-- given subsequent data, a, (presumably somehow derived from react) will
-- respond to the command, ComResp cmd.
class ServerAction cmd react a where
serverResponse :: cmd -> (react, a -> ComResp cmd)
-- The idea with forwarding action hinges to a large part around the
server response
-- (a->c->d). The idea being that whatever implementation of this server
will have
-- some data, a, available which needs to be combined with, c, to yield
data, d,
-- necessary for a response to the original metaCmd request. The data, c,
can be
-- created based on replys to visualization commands So, given the input
functions
-- which create the client trigger and initial data b, this function
handles the
-- forwarding of visualization commands based on some other commands.
forwardingAction :: forall a b c d trig metaCmd . ( Monoid c
, ServerAction metaCmd (a->c->d) d
, ClientAction VisCom trig (b->c) )
=> (metaCmd -> a -> trig) -> (metaCmd -> b)
-> metaCmd -> a
-> ([VisCom],[VisResp] -> d, d -> ComResp metaCmd)
forwardingAction toTrig tob metaCmd a = (cliCmds,servReact',cmdResp)
where
(servReact::(a->c->d),cmdResp::d -> ComResp metaCmd) = serverResponse
metaCmd
cmdActs :: [(VisCom,VisResp -> b -> c)]
cmdActs = clientRequest . toTrig metaCmd $ a
(cliCmds,replResps) = unzip cmdActs
b = tob metaCmd
replResp' :: [VisResp] -> c
replResp' resps = mconcat $ zipWith (\f resp-> f resp b) replResps
resps
servReact' :: [VisResp] -> d
servReact' resps = servReact a (replResp' resps)
}}}
Error:
{{{
src/CSFwd.hs:33:21:
Could not deduce (ClientAction VisCom trig (b -> c0))
arising from the ambiguity check for ‘forwardingAction’
from the context (Monoid c,
ServerAction metaCmd (a -> c -> d) d,
ClientAction VisCom trig (b -> c))
bound by the type signature for
forwardingAction :: (Monoid c,
ServerAction metaCmd (a -> c -> d)
d,
ClientAction VisCom trig (b -> c))
=>
(metaCmd -> a -> trig)
-> (metaCmd -> b)
-> metaCmd
-> a
-> ([VisCom], [VisResp] -> d, d ->
ComResp metaCmd)
at src/CSFwd.hs:(33,21)-(38,67)
The type variable ‘c0’ is ambiguous
In the ambiguity check for:
forall a b c d trig metaCmd.
(Monoid c, ServerAction metaCmd (a -> c -> d) d,
ClientAction VisCom trig (b -> c)) =>
(metaCmd -> a -> trig)
-> (metaCmd -> b)
-> metaCmd
-> a
-> ([VisCom], [VisResp] -> d, d -> ComResp metaCmd)
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the type signature for ‘forwardingAction’:
forwardingAction :: forall a b c d trig metaCmd. (Monoid c,
ServerAction
metaCmd (a -> c -> d) d,
ClientAction
VisCom trig (b -> c)) =>
(metaCmd -> a -> trig)
-> (metaCmd -> b)
-> metaCmd -> a -> ([VisCom], [VisResp] -> d,
d -> ComResp metaCmd)
}}}
*Technically not real 3D. I'm using some projective transforms to create
2D vector graphics based on the diagrams front end. I use a simple
ordering over the transformed shapes to determine the order they are glued
to the page.
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9607#comment:7>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list