Using field selectors in a type constructor
Graham Klyne
gk at ninebynine.org
Mon Oct 13 18:27:36 EDT 2003
I've run across a minor coding niggle on a couple opf accosions when using
a type constructor with field selectors. The full code of my test case is
below. The value 'test2' evaluates to True.
The function that niggles me is this:
[[
joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b
joinVarBindings vb1 vb2
| vbNull vb1 = vb2
| vbNull vb2 = vb1
| otherwise = VarBinding
{ vbMap = mv12
, vbEnum = map (\v -> (v,fromJust (mv12 v))) $
boundVars vb1 `union` boundVars vb2
, vbNull = False
}
where
mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
]]
Is it really necessary to define mv12 as a separate "where" clause here?
What I'd really like to do is assign it to field vbMap, and reference that
from the definition of vbEnum, but I can't figure out if there's a way
to do so. Writing this:
[[
joinVarBindings vb1 vb2
| vbNull vb1 = vb2
| vbNull vb2 = vb1
| otherwise = VarBinding
{ vbMap = head . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
, vbEnum = map (\v -> (v,fromJust (vbMap v))) $
-- error here ^^^^^^^
boundVars vb1 `union` boundVars vb2
, vbNull = False
}
]]
Results in a fairly obvious type error: I'd need to have a way to say that
vbMap is applied to the value under construction. Experience with Java would
suggest maybe something like this:
[[
, vbEnum = map (\v -> (v,fromJust (vbMap this v))) $
]]
but of course Haskell isn't Java.
Does Haskell provide a way to do this, other than the use of a 'where'
clause to factor out the common subexpression, as in my working code?
#g
--
-- spike-constructorfields.hs
import Maybe ( isJust, fromJust )
import List ( union, find )
-- |VarBinding is the type of an arbitrary variable bindings
-- value, where the type of the bound values is not specified.
data VarBinding a b = VarBinding
{ vbMap :: a -> Maybe b
, vbEnum :: [(a,b)]
, vbNull :: Bool
}
-- |nullVarBinding: maps no query variables.
nullVarBinding :: VarBinding a b
nullVarBinding = VarBinding
{ vbMap = const Nothing
, vbEnum = []
, vbNull = True
}
-- |Return a list of the variables bound by a supplied variable binding
boundVars :: VarBinding a b -> [a]
boundVars = map fst . vbEnum
-- |Join a pair of query bindings, returning a new binding that
-- maps all variables recognized by either of the input bindings.
-- If the bindings should overlap, such overlap is not detected and
-- the value from the first binding provided is used arbitrarily.
joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b
joinVarBindings vb1 vb2
| vbNull vb1 = vb2
| vbNull vb2 = vb1
| otherwise = VarBinding
{ vbMap = mv12
, vbEnum = map (\v -> (v,fromJust (mv12 v))) $
boundVars vb1 `union` boundVars vb2
, vbNull = False
}
where
mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
flist fs a = map ($ a) fs -- see also monad function 'ap'
headOrNothing :: [Maybe a] -> Maybe a
headOrNothing [] = Nothing
headOrNothing (a:_) = a
{- NOT this:
-- |Join a pair of query bindings, returning a new binding that
-- maps all variables recognized by either of the input bindings.
-- If the bindings should overlap, such overlap is not detected and
-- the value from the first binding provided is used arbitrarily.
joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b
joinVarBindings vb1 vb2
| vbNull vb1 = vb2
| vbNull vb2 = vb1
| otherwise = VarBinding
{ vbMap = head . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
, vbEnum = map (\v -> (v,fromJust (vbMap v))) $
boundVars vb1 `union` boundVars vb2
, vbNull = False
}
-}
-- |Function to make a variable binding from a list of
-- pairs of variable and corresponding assigned value.
makeVarBinding :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> VarBinding a b
makeVarBinding vrbs =
if null vrbs then nullVarBinding
else VarBinding
{ vbMap = selectFrom vrbs
, vbEnum = vrbs
, vbNull = null vrbs
}
where
-- selectFrom bs is the VarBinding lookup function
selectFrom :: (Eq a) => [(a,b)] -> a -> Maybe b
selectFrom [] _ = Nothing
selectFrom ((v,r):bs) l = if l == v then Just r
else selectFrom bs l
vb1 :: VarBinding Int String
vb1 = makeVarBinding [(1,"a"),(2,"b"),(3,"c")]
vb2 :: VarBinding Int String
vb2 = makeVarBinding [(3,"cc"),(4,"dd"),(5,"ee")]
vb12 = joinVarBindings vb1 vb2
test1 = vbEnum $ vb12
test2 = test1 == [(1,"a"),(2,"b"),(3,"c"),(4,"dd"),(5,"ee")]
test3 = [test31,test32,test33,test34]
test31 = vbMap vb12 1 -- Just "a"
test32 = vbMap vb12 3 -- Just "c"
test33 = vbMap vb12 5 -- Just "ee"
test34 = vbMap vb12 0 -- Nothing
------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact
More information about the Haskell-Cafe
mailing list