[Haskell-cafe] OOHaskell problems
Jason Dagit
dagit at eecs.oregonstate.edu
Sun Oct 1 19:00:55 EDT 2006
Hello,
I wanted to try using OOHaskell as a library, but I've run into some
problems I don't understand.
I downloaded the copy from:
http://homepages.cwi.nl/~ralf/OOHaskell/
In the HList subdirectory I created a .cabal file which exposes as
many of the modules in HList as I could. I then installed the HList
library using cabal. Back in the main OOHaskell directory I created a
.cabal file for OOHaskell which depended on the newly installed HList
library.
The OOHaskell library exposes the modules:
DeepNarrow
New
Nominal
OOHaskell
After I installed the OOHaskell library I ran:
ghc --make -package OOHaskell -package HList SimpleIO.hs
Chasing modules from: SimpleIO.hs
Compiling Nominal ( ./Nominal.hs, ./Nominal.o )
Compiling New ( ./New.hs, ./New.o )
Compiling DeepNarrow ( ./DeepNarrow.hs, ./DeepNarrow.o )
Compiling OOHaskell ( ./OOHaskell.hs, ./OOHaskell.o )
Compiling SimpleIO ( SimpleIO.hs, SimpleIO.o )
SimpleIO.hs:44:11:
No instance for (HasField (Proxy Field1) HNil v)
arising from use of `foo' at SimpleIO.hs:44:11-13
Probable fix: add an instance declaration for (HasField (Proxy
Field1) HNil v)
In the definition of `testfoo':
testfoo = foo ((field1 .=. True) .*. emptyRecord)
SimpleIO.hs:116:7:
No instance for (HasField (Proxy MoveX) HNil (a -> IO t))
arising from use of `#' at SimpleIO.hs:116:7
Probable fix:
add an instance declaration for (HasField (Proxy MoveX) HNil (a -> IO t))
In the first argument of `($)', namely `p # moveX'
In a 'do' expression: (p # moveX) $ 3
In the definition of `myFirstOOP':
myFirstOOP = do
p <- point
(p # getX) >>= System.IO.print
(p # moveX) $ 3
(p # getX) >>= System.IO.print
SimpleIO.hs:124:19:
No instance for (HasField (Proxy MutableX) HNil (IORef a))
arising from use of `#' at SimpleIO.hs:124:19
Probable fix:
add an instance declaration for (HasField (Proxy MutableX) HNil (IORef a))
In the first argument of `writeIORef', namely `(p # mutableX)'
In a 'do' expression: writeIORef (p # mutableX) 42
In the definition of `mySecondOOP':
mySecondOOP = do
p <- point
writeIORef (p # mutableX) 42
(p # getX) >>= System.IO.print
SimpleIO.hs:177:23:
No instance for (HasField (Proxy GetX) HNil (IO a))
arising from use of `#' at SimpleIO.hs:177:23
Probable fix:
add an instance declaration for (HasField (Proxy GetX) HNil (IO a))
In the second argument of `(>>=)', namely `(# getX)'
In the first argument of `(>>=)', namely `localClass >>= ((# getX))'
In the result of a 'do' expression:
(localClass >>= ((# getX))) >>= System.IO.print
SimpleIO.hs:225:8:
No instance for (HasField (Proxy GetOffset) HNil (IO a))
arising from use of `#' at SimpleIO.hs:225:8
Probable fix:
add an instance declaration for (HasField (Proxy GetOffset) HNil (IO a))
In the first argument of `(>>=)', namely `p # getOffset'
In the result of a 'do' expression: (p # getOffset) >>= System.IO.print
In the definition of `testPara':
testPara = do
p <- para_point 1
(p # getX) >>= System.IO.print
(p # moveX) $ 2
(p # getX) >>= System.IO.print
(p # getOffset) >>= System.IO.print
To investigate this further, in the OOHaskell directory I typed:
$ ghci -fglasgow-exts -fallow-overlapping-instances
-fallow-undecidable-instances -i./HList ShapesLub.hs ___ ___
_
/ _ \ /\ /\/ __(_)
/ /_\// /_/ / / | | GHC Interactive, version 6.4.2, for Haskell 98.
/ /_\\/ __ / /___| | http://www.haskell.org/ghc/
\____/\/ /_/\____/|_| Type :? for help.
Loading package base-1.0 ... linking ... done.
Compiling FakePrelude ( ./HList/FakePrelude.hs, interpreted )
Compiling HListPrelude ( ./HList/HListPrelude.hs, interpreted )
Compiling GhcExperiments ( ./HList/GhcExperiments.hs, interpreted )
Compiling HArray ( ./HList/HArray.hs, interpreted )
Compiling HZip ( ./HList/HZip.hs, interpreted )
Compiling HOccurs ( ./HList/HOccurs.hs, interpreted )
Compiling HTypeIndexed ( ./HList/HTypeIndexed.hs, interpreted )
Compiling Record ( ./HList/Record.hs, interpreted )
Compiling GhcRecord ( ./HList/GhcRecord.hs, interpreted )
Compiling Label4 ( ./HList/Label4.hs, interpreted )
Compiling New ( ./New.hs, interpreted )
Compiling TIP ( ./HList/TIP.hs, interpreted )
Compiling TIC ( ./HList/TIC.hs, interpreted )
Compiling GhcSyntax ( ./HList/GhcSyntax.hs, interpreted )
Compiling TypeCastGeneric1 ( ./HList/TypeCastGeneric1.hs, interpreted )
Compiling TypeEqBoolGeneric ( ./HList/TypeEqBoolGeneric.hs, interpreted )
Compiling TypeEqGeneric1 ( ./HList/TypeEqGeneric1.hs, interpreted )
Compiling Variant ( ./HList/Variant.hs, interpreted )
Compiling Nominal ( ./Nominal.hs, interpreted )
Compiling CommonMain ( ./HList/CommonMain.hs, interpreted )
Compiling DeepNarrow ( ./DeepNarrow.hs, interpreted )
Compiling OOHaskell ( ./OOHaskell.hs, interpreted )
Compiling Shapes ( ./Shapes.hs, interpreted )
Compiling ShapesLub ( ShapesLub.hs, interpreted )
Ok, modules loaded: ShapesLub, Shapes, OOHaskell, DeepNarrow,
CommonMain, Nominal, Variant, TypeEqGeneric1, TypeEqBoolGeneric,
TypeCastGeneric1, GhcSyntax, TIC, TIP, New, Label4, GhcRecord, Record,
HTypeIndexed, HOccurs, HZip, HArray, GhcExperiments, HListPrelude,
FakePrelude.
*ShapesLub> main
Drawing a Rectangle at:(10,20), width 5, height 6
Drawing a Rectangle at:(110,120), width 5, height 6
Drawing a Circle at:(15,25), radius 8
Drawing a Circle at:(115,125), radius 8
Drawing a Rectangle at:(0,0), width 30, height 15
*ShapesLub>
So that seemed to work, but:
$ ghci -fglasgow-exts -fallow-overlapping-instances
-fallow-undecidable-instances -package OOHaskell -package HList
ShapesLub.hs
___ ___ _
/ _ \ /\ /\/ __(_)
/ /_\// /_/ / / | | GHC Interactive, version 6.4.2, for Haskell 98.
/ /_\\/ __ / /___| | http://www.haskell.org/ghc/
\____/\/ /_/\____/|_| Type :? for help.
Loading package base-1.0 ... linking ... done.
Loading package HList-0.1 ... linking ... done.
Loading package OOHaskell-0.1 ... linking ... done.
Skipping Nominal ( ./Nominal.hs, ./Nominal.o )
Skipping New ( ./New.hs, ./New.o )
Skipping DeepNarrow ( ./DeepNarrow.hs, ./DeepNarrow.o )
Skipping OOHaskell ( ./OOHaskell.hs, ./OOHaskell.o )
Compiling Shapes ( ./Shapes.hs, interpreted )
Compiling ShapesLub ( ShapesLub.hs, interpreted )
ShapesLub.hs:30:19:
No instances for (HasField (Proxy MoveTo) HNil (a5 -> a6 -> IO t5),
HasField (Proxy GetY) HNil (IO a6),
HasField (Proxy GetX) HNil (IO a5),
HasField (Proxy SetY) HNil (t4 -> t t1),
HasField (Proxy SetX) HNil (t2 -> t t3),
HasField (Proxy GetWidth) HNil (IO a7),
HasField (Proxy GetHeight) HNil (IO a8),
HExtract HNil (Proxy Draw) (IO ()))
arising from use of `rectangle' at ShapesLub.hs:30:19-27
Probable fix:
add an instance declaration for (HasField (Proxy MoveTo)
HNil
(a5 -> a6 -> IO t5),
HasField (Proxy GetY) HNil (IO a6),
HasField (Proxy GetX) HNil (IO a5),
HasField (Proxy SetY) HNil (t4 -> t t1),
HasField (Proxy SetX) HNil (t2 -> t t3),
HasField (Proxy GetWidth) HNil (IO a7),
HasField (Proxy GetHeight) HNil (IO a8),
HExtract HNil (Proxy Draw) (IO ()))
In the first argument of `mfix', namely
`(rectangle (10 :: Int) (20 :: Int) 5 6)'
In a 'do' expression: s1 <- mfix (rectangle (10 :: Int) (20 :: Int) 5 6)
In the definition of `main':
main = do
s1 <- mfix (rectangle (10 :: Int) (20 :: Int) 5 6)
s2 <- mfix (circle (15 :: Int) 25 8)
let scribble = ...
mapM_ (\ shape -> ...) scribble
arec <- mfix (rectangle (0 :: Int) (0 :: Int) 15 15)
(arec # setWidth) $ 30
arec # draw
ShapesLub.hs:31:19:
No instance for (HasField (Proxy GetRadius) HNil (IO a6))
arising from use of `circle' at ShapesLub.hs:31:19-24
Probable fix:
add an instance declaration for (HasField (Proxy GetRadius) HNil (IO a6))
In the first argument of `mfix', namely `(circle (15 :: Int) 25 8)'
In a 'do' expression: s2 <- mfix (circle (15 :: Int) 25 8)
In the definition of `main':
main = do
s1 <- mfix (rectangle (10 :: Int) (20 :: Int) 5 6)
s2 <- mfix (circle (15 :: Int) 25 8)
let scribble = ...
mapM_ (\ shape -> ...) scribble
arec <- mfix (rectangle (0 :: Int) (0 :: Int) 15 15)
(arec # setWidth) $ 30
arec # draw
ShapesLub.hs:38:34:
No instance for (HasField (Proxy RMoveTo) HNil (t -> t1 -> IO t2))
arising from use of `#' at ShapesLub.hs:38:34
Probable fix:
add an instance declaration for (HasField (Proxy RMoveTo)
HNil
(t -> t1 -> IO t2))
In a 'do' expression: (shape # rMoveTo) 100 100
In a lambda abstraction:
\ shape
-> do
shape # draw
(shape # rMoveTo) 100 100
shape # draw
In the first argument of `mapM_', namely
`(\ shape
-> do
shape # draw
(shape # rMoveTo) 100 100
shape # draw)'
ShapesLub.hs:44:12:
No instance for (HasField (Proxy SetWidth) HNil (a -> IO t))
arising from use of `#' at ShapesLub.hs:44:12
Probable fix:
add an instance declaration for (HasField (Proxy SetWidth) HNil
(a -> IO t))
In the first argument of `($)', namely `arec # setWidth'
In a 'do' expression: (arec # setWidth) $ 30
In the definition of `main':
main = do
s1 <- mfix (rectangle (10 :: Int) (20 :: Int) 5 6)
s2 <- mfix (circle (15 :: Int) 25 8)
let scribble = ...
mapM_ (\ shape -> ...) scribble
arec <- mfix (rectangle (0 :: Int) (0 :: Int) 15 15)
(arec # setWidth) $ 30
arec # draw
ShapesLub.hs:46:12:
No instance for (HasField (Proxy Draw) HNil (IO b))
arising from use of `#' at ShapesLub.hs:46:12
Probable fix:
add an instance declaration for (HasField (Proxy Draw) HNil (IO b))
In the result of a 'do' expression: arec # draw
In the definition of `main':
main = do
s1 <- mfix (rectangle (10 :: Int) (20 :: Int) 5 6)
s2 <- mfix (circle (15 :: Int) 25 8)
let scribble = ...
mapM_ (\ shape -> ...) scribble
arec <- mfix (rectangle (0 :: Int) (0 :: Int) 15 15)
(arec # setWidth) $ 30
arec # draw
Failed, modules loaded: Shapes, OOHaskell, DeepNarrow, New, Nominal.
*Shapes>
Inspecting HasField and Proxy in the working ghci says:
*ShapesLub> :i HasField
class HasField l r v | l r -> v where hLookupByLabel :: l -> r -> v
-- Defined at ./HList/Record.hs:140:6
instance (HasField l x v, Nomination f) => HasField l (N f x) v
-- Defined at ./Nominal.hs:49:0
instance HasField l r v => HasField l (Record r) v
-- Defined at ./HList/Record.hs:143:0
instance (HEq l l' b, HasField' b l (HCons (l', v') r) v) =>
HasField l (HCons (l', v') r) v
-- Defined at ./HList/Record.hs:149:0
*ShapesLub> :i Proxy
data Proxy e -- Defined at ./HList/FakePrelude.hs:218:5
instance Show (Proxy e) -- Defined at ./HList/FakePrelude.hs:219:0
instance Typeable x => Typeable (Proxy x)
-- Defined at ./HList/GhcRecord.hs:229:0
instance TypeEq x y b => HEq (Proxy x) (Proxy y) b
-- Defined at ./HList/Label4.hs:27:0
instance (HType2HNat e l n, HTypes2HNats ps l ns) =>
HTypes2HNats (HCons (Proxy e) ps) l (HCons n ns)
-- Defined at ./HList/HTypeIndexed.hs:90:0
instance Typeable x => ShowLabel (Proxy x)
-- Defined at ./HList/Label4.hs:32:0
instance Fail (ProxyFound x) => HasNoProxies (HCons (Proxy x) l)
-- Defined at ./HList/GhcRecord.hs:73:0
instance HTypeProxied l => HTypeProxied (HCons (Proxy e) l)
-- Defined at ./HList/TIC.hs:68:0
instance HMaybied l l' =>
HMaybied (HCons (Proxy e) l) (HCons (Maybe e) l')
-- Defined at ./HList/Variant.hs:53:0
While, the ouput in the non-working ghci sessions has equivalent output:
*Shapes> :i HasField
class HasField l r v | l r -> v where hLookupByLabel :: l -> r -> v
-- Imported from Record
instance (HasField l x v, Nomination f) => HasField l (N f x) v
-- Imported from Nominal
instance (HEq l l' b, HasField' b l (HCons (l', v') r) v) =>
HasField l (HCons (l', v') r) v
-- Imported from Record
instance HasField l r v => HasField l (Record r) v
-- Imported from Record
*Shapes> :i Proxy
data Proxy e -- Imported from FakePrelude
instance Show (Proxy e) -- Imported from FakePrelude
instance Typeable x => Typeable (Proxy x)
-- Imported from GhcRecord
instance TypeEq x y b => HEq (Proxy x) (Proxy y) b
-- Imported from Label4
instance Typeable x => ShowLabel (Proxy x) -- Imported from Label4
instance Fail (ProxyFound x) => HasNoProxies (HCons (Proxy x) l)
-- Imported from GhcRecord
instance HMaybied l l' =>
HMaybied (HCons (Proxy e) l) (HCons (Maybe e) l')
-- Imported from Variant
instance HTypeProxied l => HTypeProxied (HCons (Proxy e) l)
-- Imported from TIC
instance (HType2HNat e l n, HTypes2HNats ps l ns) =>
HTypes2HNats (HCons (Proxy e) ps) l (HCons n ns)
-- Imported from HTypeIndexed
I'm at a loss to figure out why the OOHaskell library I created does
not behave the same as building the examples next to the HList source.
Thanks,
Jason
More information about the Haskell-Cafe
mailing list