template-haskell-2.10: unbound type variables about acid-state

[ddssff]

Here is the output code with the ugly extensions removed:

{-# LANGUAGE KindSignatures #-}
import Data.Acid
import Data.Acid.Advanced
import Data.Generics
import Data.Map as Map
import Data.SafeCopy
import Control.Monad.Reader
import Control.Monad.State

putValue :: Ord key => key -> val -> Update (Map key val) ()
putValue key val = modify $ Map.insert key val

lookValue :: Ord key => key -> Query (Map key val) (Maybe val)
lookValue key = ask >>= return . Map.lookup key

instance Ord k_a334 => IsAcidic Map where
  acidEvents =
      [UpdateEvent (\ (PutValue key val) -> putValue key val),
       QueryEvent (\ (LookValue key) -> lookValue key)]

data PutValue (key :: *) (val :: *) = PutValue key val deriving (Typeable)
instance Ord key => SafeCopy PutValue where
  putCopy (PutValue key val) = contain (do { safePut key; safePut val; return () })
  getCopy = contain (((return PutValue) <*> safeGet) <*> safeGet)
instance Ord key => Method PutValue where
  type MethodResult PutValue = ()
  type MethodState PutValue = Map key val
instance Ord key => UpdateEvent PutValue

newtype LookValue (key :: *) (val :: *) = LookValue key deriving (Typeable)
instance Ord key => SafeCopy LookValue where
  putCopy (LookValue arg) = contain (do { safePut arg; return () })
  getCopy = contain ((return LookValue) <*> safeGet)
instance Ord key => Method LookValue where
  type MethodResult LookValue = Maybe val
  type MethodState LookValue = Map key val
instance Ord key => QueryEvent LookValue

[ddssff]

Here is the output of ghc-7.8, cleaned up similarly:

{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}
import Control.Applicative
import Data.Acid
import Data.Acid.Advanced
import Data.Generics
import Data.Map as Map
import Data.SafeCopy
import Control.Monad.Reader
import Control.Monad.State

putValue :: Ord key => key -> val -> Update (Map key val) ()
putValue key val = modify $ Map.insert key val

lookValue :: Ord key => key -> Query (Map key val) (Maybe val)
lookValue key = ask >>= return . Map.lookup key

instance (SafeCopy k, Typeable k, SafeCopy a, Typeable a, Ord k) => IsAcidic (Map k a) where
  acidEvents = [UpdateEvent (\ (PutValue k a) -> putValue k a),
                QueryEvent (\ (LookValue a) -> lookValue a)]
data PutValue key val = PutValue key val deriving (Typeable)
instance (SafeCopy key, SafeCopy val, Ord key) => SafeCopy (PutValue key val) where
    putCopy (PutValue key val) = contain (do { safePut key; safePut val; return () })
    getCopy = contain (((return PutValue) <*> safeGet) <*> safeGet)
instance (SafeCopy key, Typeable key, SafeCopy val, Typeable val, Ord key) => Method (PutValue key val) where
  type MethodResult (PutValue key val) = ()
  type MethodState (PutValue key val) = Map key val
instance (SafeCopy key, Typeable key, SafeCopy val, Typeable val, Ord key) => UpdateEvent (PutValue key val)

newtype LookValue key val = LookValue key deriving (Typeable)
instance (SafeCopy key, SafeCopy val, Ord key) => SafeCopy (LookValue key val) where
  putCopy (LookValue key) = contain (do { safePut key; return () })
  getCopy = contain ((return LookValue) <*> safeGet)
instance (SafeCopy key, Typeable key, SafeCopy val, Typeable val, Ord key) => Method (LookValue key val) where
  type MethodResult (LookValue key val) = Maybe val
  type MethodState (LookValue key val) = Map key val
instance (SafeCopy key, Typeable key, SafeCopy val, Typeable val, Ord key) => QueryEvent (LookValue key val)

[ddssff]

I don't really know if this is a template-haskell-2.10 issue or a base-4.8 issue.

[ddssff]

Ok, now I understand this problem. First, there are missing superclasses in the code above, and it now needs the TypeFamilies directive:

{-# LANGUAGE KindSignatures, TemplateHaskell, TypeFamilies #-}
import Control.Monad.Reader (ask)
import Control.Monad.State (modify)
import Data.Acid (Update, Query, makeAcidic)
import Data.Data (Data, Typeable)
import Data.Map as Map (insert, lookup, Map)
import Data.SafeCopy (SafeCopy)

putValue :: (SafeCopy key, Ord key, Typeable key, SafeCopy val, Typeable val) => key -> val -> Update (Map key val) ()
putValue key val = modify $ Map.insert key val

lookValue :: (SafeCopy key, Ord key, Typeable key, SafeCopy val, Typeable val) => key -> Query (Map key val) (Maybe val)
lookValue key = ask >>= return . Map.lookup key

$(makeAcidic ''Map ['putValue, 'lookValue])

Now we get these messages:

Bug.hs:15:3:
    The RHS of an associated type declaration mentions ‘val_a2rS’
      All such variables must be bound on the LHS

Bug.hs:15:3:
    The RHS of an associated type declaration mentions ‘key_a2rR’, ‘val_a2rS’
      All such variables must be bound on the LHS

Bug.hs:15:3:
    The RHS of an associated type declaration mentions ‘key_a2Xh’, ‘val_a2Xi’
      All such variables must be bound on the LHS

This is because makeAcidic throws away kinded type variables where I suspect it should treat them the same way it does plain type variables. Now that I poke around, it looks like I proposed a solution in #53, now I have pull request #56 as well.

[oxij]

This is still an issue.

{-# LANGUAGE KindSignatures, TemplateHaskell #-}

module Main where

import Data.Acid
import Data.SafeCopy
import Data.Typeable

----------------------

data Bad q = Bad
     { foo :: ()
     , bar :: ()
     } deriving (Show, Typeable)

$(deriveSafeCopy 0 'base ''Bad)

serverUpdate :: q -> Update (Bad q) ()
serverUpdate = undefined

$(makeAcidic ''Bad [ 'serverUpdate ])

breaks with

Test.hs:21:3-36: The exact Name ‘q_a5STR’ is not in scope …
      Probable cause: you used a unique Template Haskell name (NameU), 
      perhaps via newName, but did not bind it
      If that's it, then -ddump-splices might be useful
Compilation failed.

generated splice:

    makeAcidic ''Bad ['serverUpdate]
  ======>
    instance IsAcidic Bad where
      acid-state-0.13.0:Data.Acid.Common.acidEvents
        = [acid-state-0.13.0:Data.Acid.Common.UpdateEvent
             (\ (ServerUpdate arg_a9tH) -> serverUpdate arg_a9tH)]
    newtype ServerUpdate (q_a6dl :: *)
      = ServerUpdate q_a6dl
      deriving (Typeable)
    instance SafeCopy ServerUpdate where
      putCopy (ServerUpdate arg_a9tG)
        = contain
            (do { safePut arg_a9tG;
                  return () })
      getCopy = contain ((return ServerUpdate) <*> safeGet)
    instance Data.Acid.Core.Method ServerUpdate where
      type Data.Acid.Core.MethodResult ServerUpdate = ()
      type Data.Acid.Core.MethodState ServerUpdate = Bad q_a6dl
    instance UpdateEvent ServerUpdate

[ddssff]

With or without my patch in pull request #56?

[oxij]

Ah, I misunderstood it to be merged. With the patch applied this example actually compiles. Yay! I say `acid-state` TH needs tests. And all these examples here should be in there.

[adamgundry]

Looks like this has long been fixed (#56 was merged), and I've added a basic test in #105.