[Haskell-cafe] Instance classes and error (also,
related to Data.Binary.GET)
bbrown
bbrown at botspiritcompany.com
Thu Jan 3 18:13:10 EST 2008
I am using the Data.Binary module and having some issues reading big endian
files (actually, just reading the file). I can read the header but not the
rest of the data which contains a set of row information. Also, go ahead and
make fun my style of coding.
Anyway, This is the my code and the error at the bottom.
The issue stems from here, it says I didn't define an instance, but I did:
instance Binary URLSet where
put _ = do BinaryPut.putWord8 0
get = do
remainingByteData <- BinaryGet.getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
x :: KeywordsInfo <- decode remainingByteData
return (URLSet {urlinfo=i, titleinfo=j,
descrinfo=k, keywordsinfo=x})
-----
module Main where
import Data.Word
import Data.Binary
import qualified Data.ByteString.Lazy.Char8 as BSLC8
import Data.ByteString.Lazy (ByteString)
import Data.Binary.Get as BinaryGet
import Data.Binary.Put as BinaryPut
import IO
import Text.Printf
import System.Environment
import Control.Monad (replicateM, liftM)
{- *********************************************************
Define the Database Data Types
SpiderDatabase represents a singleton wrapper for an
entire database.
********************************************************* -}
data SpiderDatabase = SpiderDatabase {
magicNumberA :: Word16,
magicNumberB :: Word16,
majorVers :: Word16,
minorVers :: Word16,
headerTag :: Word16,
poolLen :: Word16,
spiderpool :: [URLSet]
}
data URLSet = URLSet {
urlinfo :: URLInfo,
titleinfo :: TitleInfo,
descrinfo :: DescrInfo,
keywordsinfo :: KeywordsInfo
}
data URLInfo = URLInfo {
tag :: Word8,
urlid :: Word16,
urllen :: Word16,
url :: ByteString
}
data TitleInfo = TitleInfo {
titletag :: Word8,
titlelen :: Word16,
title :: ByteString
}
data DescrInfo = DescrInfo {
descrtag :: Word8,
descrlen :: Word16,
descr :: ByteString
}
data KeywordsInfo = KeywordsInfo {
keywordstag :: Word8,
keywordslen :: Word16,
keywords :: ByteString
}
{- *********************************************************
Class instances
********************************************************* -}
instance Show SpiderDatabase where
show db = let magicb = (magicNumberB db)
header = (headerTag db)
poolct = (poolLen db)
in "<<<Database Content>>>\n" ++
(((printf "Magic: %X %X\n") (magicNumberA db)) (magicNumberB
db)) ++
printf "URL Pool Count: %d\n" poolct ++
"<<<End>>>"
instance Binary URLInfo where
put _ = do BinaryPut.putWord8 0
get = do
urltag <- getWord8
idx <- getWord16be
len <- getWord16be
strdata <- BinaryGet.getLazyByteString (fromIntegral len)
return (URLInfo {tag=urltag, urlid=idx,
urllen=len, url=strdata})
instance Binary DescrInfo where
put _ = do BinaryPut.putWord8 0
get = do
tag <- getWord8
len <- getWord16be
strdata <- BinaryGet.getLazyByteString (fromIntegral len)
return (DescrInfo {descrtag=tag,
descrlen=len,
descr=strdata})
instance Binary TitleInfo where
put _ = do BinaryPut.putWord8 0
get = do
tag <- getWord8
len <- getWord16be
strdata <- BinaryGet.getLazyByteString (fromIntegral len)
return (TitleInfo {titletag=tag,
titlelen=len,
title=strdata})
instance Binary KeywordsInfo where
put _ = do BinaryPut.putWord8 0
get = do
tag <- getWord8
len <- getWord16be
strdata <- BinaryGet.getLazyByteString (fromIntegral len)
return (KeywordsInfo {keywordstag=tag,
keywordslen=len,
keywords=strdata})
instance Binary URLSet where
put _ = do BinaryPut.putWord8 0
get = do
remainingByteData <- BinaryGet.getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
x :: KeywordsInfo <- decode remainingByteData
return (URLSet {urlinfo=i, titleinfo=j,
descrinfo=k, keywordsinfo=x})
instance Binary SpiderDatabase where
put _ = do BinaryPut.putWord8 0
get = do
magicnumbera <- BinaryGet.getWord16be
magicnumberb <- BinaryGet.getWord16be
major <- BinaryGet.getWord16be
minor <- BinaryGet.getWord16be
header <- BinaryGet.getWord16be
poolct <- BinaryGet.getWord16be
-- *******************************
-- Get the remaining byte string data,
-- So that we can use lazy bytestring to load to load the
-- the data types.
-- *******************************
remainingByteData <- BinaryGet.getRemainingLazyByteString
-- pool <- (replicate (fromIntegral poolct) (decode remainingByteData))
z :: URLSet <- decode remainingByteData
return (SpiderDatabase {magicNumberA=magicnumbera,
magicNumberB=magicnumberb,
majorVers=major,
minorVers=minor,
headerTag=header,
poolLen=poolct
})
main = do
putStrLn "Running Spider Database Reader"
args <- getArgs
db :: SpiderDatabase <- decodeFile (args !! 0)
putStrLn $ show db
putStrLn "Done"
***
*** Error:
DbReader.hs:119:22:
No instance for (Binary (Get URLInfo))
arising from a use of `decode' at DbReader.hs:119:22-45
Possible fix:
add an instance declaration for (Binary (Get URLInfo))
In a 'do' expression: i :: URLInfo <- decode remainingByteData
In the expression:
do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
....
In the definition of `get':
get = do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
....
DbReader.hs:120:24:
No instance for (Binary (Get TitleInfo))
arising from a use of `decode' at DbReader.hs:120:24-47
Possible fix:
add an instance declaration for (Binary (Get TitleInfo))
In a 'do' expression: j :: TitleInfo <- decode remainingByteData
In the expression:
do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
....
In the definition of `get':
get = do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
....
DbReader.hs:121:24:
No instance for (Binary (Get DescrInfo))
arising from a use of `decode' at DbReader.hs:121:24-47
Possible fix:
add an instance declaration for (Binary (Get DescrInfo))
In a 'do' expression: k :: DescrInfo <- decode remainingByteData
In the expression:
do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
....
In the definition of `get':
get = do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
....
DbReader.hs:122:27:
No instance for (Binary (Get KeywordsInfo))
arising from a use of `decode' at DbReader.hs:122:27-50
Possible fix:
add an instance declaration for (Binary (Get KeywordsInfo))
In a 'do' expression: x :: KeywordsInfo <- decode remainingByteData
In the expression:
do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
k :: DescrInfo <- decode remainingByteData
....
In the definition of `get':
get = do remainingByteData <- getRemainingLazyByteString
i :: URLInfo <- decode remainingByteData
j :: TitleInfo <- decode remainingByteData
....
DbReader.hs:142:21:
No instance for (Binary (Get URLSet))
arising from a use of `decode' at DbReader.hs:142:21-44
Possible fix: add an instance declaration for (Binary (Get URLSet))
In a 'do' expression: z :: URLSet <- decode remainingByteData
In the expression:
do magicnumbera <- getWord16be
magicnumberb <- getWord16be
major <- getWord16be
minor <- getWord16be
....
In the definition of `get':
get = do magicnumbera <- getWord16be
magicnumberb <- getWord16be
major <- getWord16be
....
make: *** [dbreader] Error 1
--
Berlin Brown
[berlin dot brown at gmail dot com]
http://botspiritcompany.com/botlist/?
More information about the Haskell-Cafe
mailing list