[Haskell-cafe] IO Monad/ haskelldb strange error?
Marc Weber
marco-oweber at gmx.de
Tue Aug 8 04:33:51 EDT 2006
line << 39 works fine
line 56 doesn't. Why?
Isn't both a IO monad (because of the print statements)
After commenting out 56 it compiles fine
Any suggestion appreciated.. I'm struggling for some hours now..
module Modules.ObjectTree where
import Debug.Trace
import Data.FunctorM
import DBUtils
import qualified DB.VT.Ezcontentobject_tree as EOT
import qualified DB.VT.Ezcontentobject as CO
import Database.HaskellDB.HDBRec
import Database.HaskellDB
import Database.HaskellDB.Query as Q
import Data.Tree
import Monad
import Control.Monad.Trans
import Maybe
import qualified List
instance FunctorM Tree where
fmapM f (Node a forest) = do
a' <- f a
forest' <- mapM (fmapM f) forest
return $ Node a' forest'
type ObjectTree a = Tree (Record a)
truncTree 1 (Node a _) = Node a []
truncTree x (Node a forest) = Node a $ map (truncTree (x-1)) forest
oT con = do
print "blah" -- because of this we should have a simple IO Monad ?
lookupField con (CO.name) (CO.ezcontentobject) (CO.xid) (constant (1 :: Int)) >>= print :: IO () -- <<<<<<<<<<<<<<<<<<<<<<<<< 39
return "blah"
-- printObjectsAsTree :: MonadIO m => ((Database -> m a) -> m a) -> Int -> IO ()
printObjectsAsTree con startid= do
print "test"
root <- liftM head $ lRS (EOT.parent_node_id) (constant (startid :: Int))
print root
--showRS root >>= putStrLn
node <- po root
node_show <- fmapM showRS node
return $ drawTree node_show
-- return "end"
where lRS = lookupFieldRS con (EOT.ezcontentobject_tree)
po root = let root_id = (root!(EOT.node_id) :: Int)
in do print "dumm" -- IO Monad too ?
print (root!(EOT.node_id))
lookupField con (CO.name) (CO.ezcontentobject) (CO.xid) (constant (1 :: Int)) >>= print -- <<<<<<<<<<<<<< 56
return $ Node root []
--childs <- lRS (EOT.parent_node_id) (constant root_id)
--mapM_ (\r -> r!(EOT.node_id)) childs >>= print
showRS r = do -- name <- lookupField con (CO.name) (CO.ezcontentobject) (CO.xid) (constant 1) >>= print
return "ab" :: IO String
--return $ (show $ r!node_id) ++ " (" ++ (fromJust name) ++ " )"
-----------------------------------------------
|| Preprocessing executables for dbez-0.0...
|| Building dbez-0.0...
|| Chasing modules from: db_ez.hs
|| [1 of 6] Skipping DBUtils ( DBUtils.hs, dist/build/db_ez/db_ez-tmp/DBUtils.o )
|| [2 of 6] Skipping DB.VT.Ezcontentobject_tree ( DB/VT/Ezcontentobject_tree.hs, dist/build/db_ez/db_ez-tmp/DB/VT/Ezcontentobject_tree.o )
|| [3 of 6] Skipping DB.VT.Ezcontentobject ( DB/VT/Ezcontentobject.hs, dist/build/db_ez/db_ez-tmp/DB/VT/Ezcontentobject.o )
|| [4 of 6] Compiling Modules.ObjectTree ( Modules/ObjectTree.hs, dist/build/db_ez/db_ez-tmp/Modules/ObjectTree.o )
||
Modules/ObjectTree.hs|43| 0:
|| Couldn't match `DB.VT.Ezcontentobject_tree.Contentobject_id'
|| against `DB.VT.Ezcontentobject.Contentclass_id'
|| Expected type: RecCons DB.VT.Ezcontentobject_tree.Contentobject_id
|| (Maybe Int)
|| vr
|| Inferred type: RecCons DB.VT.Ezcontentobject.Contentclass_id
|| Int
|| vr1
|| When using functional dependencies to combine
|| Database.HaskellDB.Database.GetRec (RecCons f (Expr a) er)
|| (RecCons f a vr),
|| arising from the instance declaration at Imported from Database.HaskellDB.Database
|| Database.HaskellDB.Database.GetRec (RecCons DB.VT.Ezcontentobject_tree.Contentobject_id
|| (Expr (Maybe Int))
[...]
|| (RecCons DB.VT.Ezcontentobject_tree.Sort_order
|| (Expr (Maybe Int))
|| RecNil))))))))))))))))
|| (RecCons DB.VT.Ezcontentobject.Contentclass_id Int vr),
arising from use of `lookupFieldRS' at Modules/ObjectTree.hs|52| 14-26
|| When generalising the type(s) for `printObjectsAsTree'
More information about the Haskell-Cafe
mailing list