Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

So I'm curious about a few things that I did here design wise, as well as one space I'm sure I can be given improvements from real haskellers.

The part I really think can be done better that I'm falling short is my validateItem/validateStore/validateUser methods, these just feel more convoluted than I'm sure a true haskeller could get them, little help there would be greatly appreciated.

Design wise, I'm curious if it is common to create alongside a data model a hand full of accessor functions like I did (I hear I could plausibly solve this with lenses). Is it common/uncommon to do so, are such usually not exposed or?

Anything else you see feel free to comment on (I am truly no real haskeller), but those 2 points are the main things I would like feedback on, if you ignore the rest of it but give me input on those I would love it.

Thanks!

import qualified Data.Set as S(fromList, isSubsetOf)
import qualified Data.List as L(isInfixOf)

type Name = String

data Amount = Out | Some | Enough | Plenty deriving (Show, Eq)
data Container = Container Name deriving (Show, Eq)
data Category = Category Name deriving (Show, Eq, Ord)
data Store = Store Name [Category] deriving (Show, Eq)
data Item = Item Name Container Category Amount Store deriving Show
instance Eq (Item) where
  (==) i1 i2 = (getItemName i1) == (getItemName i2)

data User = User Name [Container] [Category] [Store] [Item] deriving Show
instance Eq (User) where
  (==) u1 u2 = (getName u1) == (getName u2)

store n1 c2ns = Store n1 $ map Category c2ns
item n1 c1n c2n a s1 = Item n1 (Container c1n) (Category c2n) a s1

getName (User n1 _ _ _ _) = n1
getContainers (User _ c1 _ _ _) = c1
getCategories (User _ _ c2 _ _) = c2
getStores (User _ _ _ s1 _) = s1
getItems (User _ _ _ _ i1) = i1

getContainerName (Container n2) = n2

getCategoryName (Category n3) = n3

getStoreName (Store n3 _) = n3
getStoreCategories (Store _ c5) = c5

getItemName (Item n2 _ _ _ _) = n2
getItemContainer (Item _ c3 _ _ _) = c3
getItemCategory (Item _ _ c4 _ _) = c4
getItemAmount (Item _ _ _ a1 _) = a1
getItemStore (Item _ _ _ _ s2) = s2

setName (User _ c1 c2 s1 i1) n = validate $ User n c1 c2 s1 i1
setContainers (User n1 _ c2 s1 i1) c1 = validate $ User n1 c1 c2 s1 i1
setCategories (User n1 c1 _ s1 i1) c2 = validate $ User n1 c1 c2 s1 i1
setStores (User n1 c1 c2 _ i1) s = validate $ User n1 c1 c2 s i1
setItems (User n1 c1 c2 s1 _) i = validate $ User n1 c1 c2 s1 i

setItemName u i n = setValue u i f where f (Item n2 c3 c4 a1 s2) = Item n c3 c4 a1 s2
setItemContainer u i c = setValue u i f where f (Item n2 c3 c4 a1 s2) = Item n2 c c4 a1 s2
setItemCategory u i c = setValue u i f where f (Item n2 c3 c4 a1 s2) = Item n2 c3 c a1 s2
setItemAmount u i a = setValue u i f where f (Item n2 c3 c4 a1 s2) = Item n2 c3 c4 a s2
setItemStore u i s = setValue u i f where f (Item n2 c3 c4 a1 s2) = Item n2 c3 c4 a1 s

setValue u i f = setValue1 u [] i f
setValue1 (User n1 c1 c2 s1 []) ia i f = validate $ User n1 c1 c2 s1 []
setValue1 (User n1 c1 c2 s1 ((Item n2 c3 c4 a1 s2):is)) ia i f
  | n2 /= i = setValue1 (User n1 c1 c2 s1 is) ((Item n2 c3 c4 a1 s2):ia) i f
  | otherwise = validate $ User n1 c1 c2 s1 $ ia ++ ((f $ Item n2 c3 c4 a1 s2):is)

addContainer u c = setContainers u (c:getContainers u)
addCategory u c = setCategories u (c:getCategories u)
addStore u s = setStores u (s:getStores u)
addItem u i = setItems u (i:getItems u)

validateItem c1 c2 s2 i1
  | not $ getItemContainer i1 `elem` c1 = Left $ i1n ++ "'s container '" ++ i1c1n ++ "' is unknown"
  | not $ getItemCategory i1 `elem` c2 = Left $ i1n ++ "'s category '" ++ i1c2n  ++ "' is unknown"
  | not $ getItemStore i1 `elem` s2 = Left $ i1n ++ "'s store '" ++ i1sn ++ "' is unknown"
  | otherwise = Right i1
  where i1n = getItemName i1
        i1c1n = getContainerName $ getItemContainer i1
        i1c2n = getCategoryName $ getItemCategory i1
        i1sn = getStoreName $ getItemStore i1

validateStore c2 s1
  | S.fromList (getStoreCategories s1) `S.isSubsetOf` S.fromList c2 = Right s1
  | otherwise = Left $ getStoreName s1 ++ " has an unknown category"

validate u = validateItems >> validateStoreCategories >> Right u
 where
   c1 = getContainers u
   c2 = getCategories u
   s1 = getStores u
   i1 = getItems u
   validateItems = foldl (\x y -> x >> validateItem c1 c2 s1 y) (validateItem c1 c2 s1 $ head i1) i1
   validateStoreCategories = foldl (\x y -> x >> validateStore c2 y) (validateStore c2 $ head s1) s1

--
--
-- TEST JUNK BELOW
--
--

myHouse = [Container "Bathroom Closer", Container "Fridge", Container "Pantry", Container "Cabinet", Container "Freezer"]

myKindOfStuff = [Category "Groceries", Category "Bathroom"]

myCity = [Store "King Soopers" [Category "Groceries"], Store "Safeway" [Category "Groceries"]]

myStuff = [Item "Milk" (Container "Fridge") (Category "Groceries") Out (Store "King Soopers" [Category "Groceries"])]

me = User "Yay" myHouse myKindOfStuff myCity myStuff


test = foldl1 (>>) $ map print $ testSummary:"":"Failed tests:":failedResults
  where
    testSummary = concat $ (show $ length passedResults):" tests passed, and ":(show $ length failedResults):" failed.":[]
    failedResults = filter (L.isInfixOf "Failed") testSet
    passedResults = filter (L.isInfixOf "Passed") testSet
    testSet = [t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16]
    t1 = case validate me of (Right u) -> "t1 Passed: " ++ (show u); (Left x) -> "t1 Failed: " ++ x
    t2 = case addStore me $ store "badCategory" ["Groceries", "Bathroom", "bad"] of
      (Right u) -> "t2 Failed: " ++ (show u); (Left x) -> "t2 Passed: " ++ x
    t3 = case addStore me $ store "noCategory" [] of
      (Right u) -> "t3 Passed: " ++ (show u); (Left x) -> "t3 Failed: " ++ x
    t4 = case addStore me $ store "goodCategory" ["Groceries"] of
      (Right u) -> "t4 Passed: " ++ (show u); (Left x) -> "t4 Failed: " ++ x
    t5 = case addStore me $ store "goodCategories" ["Groceries", "Bathroom"] of
      (Right u) -> "t5 Passed: " ++ (show u); (Left x) -> "t5 Failed: " ++ x
    t6 = case addItem me $ item "badContainer" "bad" "Groceries" Some (head myCity) of
      (Right u) -> "t6 Failed: " ++ (show u); (Left x) -> "t6 Passed: " ++ x
    t7 = case addItem me $ item "blankContainer" [] "Groceries" Some (head myCity) of
      (Right u) -> "t7 Failed: " ++ (show u); (Left x) -> "t7 Passed: " ++ x
    t8 = case addItem me $ item "goodContainer" "Fridge" "Groceries" Some (head myCity) of
      (Right u) -> "t8 Passed: " ++ (show u); (Left x) -> "t8 Failed: " ++ x
    t9 = case addItem me $ item "badCategory" "Fridge" "bad" Some (head myCity) of
      (Right u) -> "t9 Failed: " ++ (show u); (Left x) -> "t9 Passed: " ++ x
    t10 = case addItem me $ item "blankCategory" "Fridge" "" Some (head myCity) of
      (Right u) -> "t10 Failed: " ++ (show u); (Left x) -> "t10 Passed: " ++ x
    t11 = case addItem me $ item "goodCategory" "Fridge" "Groceries" Some (head myCity) of
      (Right u) -> "t11 Passed: " ++ (show u); (Left x) -> "t11 Failed: " ++ x
    t12 = case addItem me $ item "badStoreName" "Fridge" "Groceries" Some $ store "bad" [] of
      (Right u) -> "t12 Failed: " ++ (show u); (Left x) -> "t12 Passed: " ++ x
    t13 = case addItem me $ item "blankStoreName" "Fridge" "Groceries" Some $ store "" [] of
      (Right u) -> "t13 Failed: " ++ (show u); (Left x) -> "t13 Passed: " ++ x
    t14 = case addItem me $ item "badStoreCategory" "Fridge" "Groceries" Some $ store "Safeway" ["bad"] of
      (Right u) -> "t14 Failed: " ++ (show u); (Left x) -> "t14 Passed: " ++ x
    t15 = case addItem me $ item "blankStoreCategory" "Fridge" "Groceries" Some $ store "Safeway" [] of
      (Right u) -> "t15 Failed: " ++ (show u); (Left x) -> "t15 Passed: " ++ x
    t16 = case addItem me $ item "goodStoreCategory" "Fridge" "Groceries" Some $ store "Safeway" ["Groceries"] of
      (Right u) -> "t16 Passed: " ++ (show u); (Left x) -> "t16 Failed: " ++ x
share|improve this question
    
I don't know enough Haskell to give this a full review, but it seems to me that record syntax could eliminate at least some of the annoying get functions, especially for User? Also, some type signatures would really help here. –  Yuushi Feb 1 '13 at 7:25
    
@Yuushi thanks I always put type signatures after I get the whole thing working and want to export the module, and as such end up forgetting them! Thanks for the reminder! As for the record syntax, I don't want to pollute importers of the module, I spoke this over with #haskell last night and they told me the get/set functions are normal approach but also record syntax is common, and idiomatically how the get/set functions tend to work while record syntax isn't exported, thanks for looking it over! That's a review, write it as an answer and you'll get my vote for the help :) –  Jimmy Hoffa Feb 1 '13 at 15:34

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.