@@ -79,6 +79,24 @@ data Term | RegexTerm String [String] deriving (Eq, Ord) +-- Another design would be to split the Term type into +-- SimpleTerm|CompositeTerm, and then do everything in one go, but +-- that complicates syntax and semantics for end users. Let's do this +-- one ugly thing instead, eh? +a = AtomTerm +compositeTerm NilTerm = ListTerm [] +compositeTerm (BoolTerm True) = TupleTerm [a "bert", a "true"] +compositeTerm (BoolTerm False) = TupleTerm [a "bert", a "false"] +compositeTerm (DictionaryTerm kvs) = + TupleTerm [a "bert", a "dict", + ListTerm $ map (\(k, v) -> TupleTerm [k, v]) kvs] +compositeTerm (TimeTerm t) = + TupleTerm [a "bert", a "time", IntTerm mS, IntTerm s, IntTerm uS] + where + (mS, s, uS) = decomposeTime t +compositeTerm (RegexTerm s os) = + TupleTerm [a "bert", a "regex", ListTerm $ map a os] + instance Show Term where -- Provide an erlang-compatible 'show' for terms. The results of -- this should be parseable as erlang source. @@ -104,22 +122,8 @@ showTerm (BinaryTerm b) wrap x = "<<" ++ x ++ ">>" showTerm (BigintTerm x) = show x showTerm (BigbigintTerm x) = show x -showTerm NilTerm = "[]" -showTerm (BoolTerm x) = - printf "{bert, %s}" $ b x - where - b True = "true" - b False = "false" -showTerm (DictionaryTerm kvs) = - printf "{bert, dict, [%s]}" kvs' - where - kvs' = intercalate ", " - $ map (\(k, v) -> "{" ++ show k ++ "," ++ show v ++ "}") kvs -showTerm (TimeTerm t) = - printf "{bert, time, %s}" $ intercalate ", " $ map show [mS, s, uS] - where (mS, s, uS) = decomposeTime t -showTerm (RegexTerm s os) = - printf "{bert, regex, \"%s\", [%s]}" s (intercalate ", " $ map (showTerm . AtomTerm) os) +-- All other terms are composite: +showTerm t = showTerm . compositeTerm $ t class BERT a where -- | Introduce a 'Term' from a Haskell value. @@ -244,29 +248,11 @@ putTerm (ListTerm value) where len = length value putNil = putWord8 106 - putTerm (BinaryTerm value) = tag 109 >> (put32i $ B.length value) >> putL value putTerm (BigintTerm value) = tag 110 >> putBigint put8i value putTerm (BigbigintTerm value) = tag 111 >> putBigint put32i value --- Complex terms: -putTerm NilTerm = putTerm $ TupleTerm [AtomTerm "bert", AtomTerm "nil"] -putTerm (BoolTerm value) = - putTerm $ TupleTerm [AtomTerm "bert", AtomTerm value'] - where - value' = if value then "true" else "false" -putTerm (DictionaryTerm value) = - putTerm $ TupleTerm [ - AtomTerm "bert", AtomTerm "dict", - ListTerm $ map (\(k, v) -> TupleTerm [k, v]) value] -putTerm (TimeTerm t) = - putTerm $ TupleTerm [ - AtomTerm "bert", AtomTerm "time", - IntTerm mS, IntTerm s, IntTerm uS] - where (mS, s, uS) = decomposeTime t -putTerm (RegexTerm s os) = - putTerm $ TupleTerm [ - AtomTerm "bert", AtomTerm "regex", - BytelistTerm (C.pack s), ListTerm $ map AtomTerm os] +-- All other terms are composite: +putTerm t = (putTerm . compositeTerm) $ t -- | Binary decoding of a single term (without header) getTerm = do @@ -286,6 +272,7 @@ getTerm = do 111 -> getBigint get32i >>= return . BigintTerm . fromIntegral where getN n = replicateM n getTerm + -- First try & decode composite terms. tupleTerm [AtomTerm "bert", AtomTerm "true"] = return $ BoolTerm True tupleTerm [AtomTerm "bert", AtomTerm "false"] = return $ BoolTerm False tupleTerm [AtomTerm "bert", AtomTerm "dict", ListTerm kvs] = @@ -304,6 +291,7 @@ getTerm = do options [] = return [] options ((AtomTerm o):os) = options os >>= return . (o:) options _ = fail "regex options must be atoms" + -- All other tuples are just .. tuples tupleTerm xs = return $ TupleTerm xs putBigint putter value = do Data/BERT/Term.hs 8ca25f5aee7a5b24765efc7d3b646f854a20149c marius a. eriksen marius@monkey.org http://github.com/mariusaeriksen/bert/commit/dfb6ce5b60f7f95272f1bb16af743d3e99ed4bf7 dfb6ce5b60f7f95272f1bb16af743d3e99ed4bf7 2009-11-01T18:53:15-08:00 2009-11-01T18:53:15-08:00 refactor & simplify handling of composite terms d6f817503890b4e533dafb1800ba7ae0efe927f5 marius a. eriksen marius@monkey.org