set.hs

module SetPrime where

-- import qualified Data. as List
    -- no need to import List, as the function all is in the Prelude
import Control.Applicative ((<$>), (<*>))
    -- prefer explicit imports most of the time


data Shape = Oval | Squiggle | Diamond deriving (Show, Eq, Bounded, Enum, Ord)
data Color = Red | Purple | Green deriving (Show, Eq, Bounded, Enum, Ord)
data Number = One | Two | Three deriving (Show, Eq, Bounded, Enum, Ord)
data Shading = Solid | Striped | Outlined deriving (Show, Eq, Bounded, Enum, Ord)

data Jargon = Foo | Bar | Baz
    deriving (Show, Eq, Bounded, Enum, Ord)
    -- usually put the deriving on it's own line to make constructors stand out


data Card = Card Shape Color Number Shading deriving (Show, Eq, Ord)

isSet :: Card -> Card -> Card -> Bool
isSet (Card s1 c1 n1 h1) (Card s2 c2 n2 h2) (Card s3 c3 n3 h3) =
    isSetFeature s1 s2 s3 && isSetFeature c1 c2 c3
    && isSetFeature n1 n2 n3 && isSetFeature h1 h2 h3
    -- you can break long lines without fear

isSetFeature :: (Eq a) => a -> a -> a -> Bool
isSetFeature a b c
    | a == b && b == c           = True
    | a /= b && b /= c && a /= c = True
    | otherwise                  = False

completeSet :: Card -> Card -> Card
completeSet (Card s1 c1 n1 h1) (Card s2 c2 n2 h2) =
    Card (completeSetFeature s1 s2) (completeSetFeature c1 c2)
         (completeSetFeature n1 n2) (completeSetFeature h1 h2)
         -- sometimes I line things up for clarity

completeSetFeature :: (Enum a, Bounded a, Eq a) => a -> a -> a
completeSetFeature a b
    | a == b = a
    | otherwise = head [c | c <- [minBound..maxBound], c /= a && c /= b]
    -- this is the only one that made me queasy - as I don't like using head
    -- in this case, while it is easy to convince yourself that it will never
    -- fail for the types you use it with, this function is pretty general.
    -- it *will* fail in this case:
    --      completeSetFeature False True
    -- If this were production code I'd do one of two things:
    --     just make it a local function of completeSet so that it can't leak
    -- or  perhaps create a typeclass TrinaryAttribute to ensure this is only
    --     used with enums of three values

findSets :: [Card] -> [(Card, Card, Card)]
findSets cs = filter (\(c1, c2, c3) -> isSet c1 c2 c3) allTriples
  where
    allTriples = [(c1, c2, c3) | c1 <- cs, c2 <- cs, c2 > c1, c3 <- cs, c3 > c2]
    -- clever way to generate these, so I'd pull it out into a local
    -- reordering the c2 > c1 condition will make this faster as assignments
    -- and conditions are applied in order left to right

cardFromString :: String -> Card
cardFromString s = Card (shapeFromString s) (colorFromString s) (numberFromString s) (shadingFromString s)
    -- is the order of the characters in the string expected to be fixed?
    -- this isn't a total function - what is cardFromString "haha"?

cardFromString' :: String -> Maybe Card
cardFromString' (s:c:n:h:[]) =
    Card <$> shapeChar s <*> colorChar c <*> numberChar n <*> shadingChar h
        -- <$> and <*> from Control.Applicative are worth knowning
        -- in this case, they let you apply Card to a series of Maybe'd
        -- args, and only get the application if they are all Just
  where
    shapeChar c = lookup c $ zip "OSD" [Oval, Squiggle, Diamond]
    colorChar c = lookup c $ zip "rpg" [Red, Purple, Green]
    numberChar c = lookup c $ zip "123" [One, Two, Three]
    shadingChar c = lookup c $ zip "#=@" [Solid, Striped, Outlined]

cardFromString' _ = Nothing

shapeFromString :: String -> Shape
shapeFromString s
    | elem 'O' s = Oval
    | elem 'S' s = Squiggle
    | elem 'D' s = Diamond

colorFromString :: String -> Color
colorFromString s
    | elem 'r' s = Red
    | elem 'p' s = Purple
    | elem 'g' s = Green

numberFromString :: String -> Number
numberFromString s
    | elem '1' s = One
    | elem '2' s = Two
    | elem '3' s = Three

shadingFromString :: String -> Shading
shadingFromString s
    | elem '#' s = Solid
    | elem '=' s = Striped
    | elem '@' s = Outlined

exampleSets =
    [ (Card Oval Red Two Outlined, Card Oval Red Two Striped, Card Oval Red Two Solid)
    , (Card Squiggle Green One Striped, Card Oval Purple Two Striped, Card Diamond Red Three Striped)
    , (Card Oval Purple One Striped, Card Diamond Green Two Solid, Card Squiggle Red Three Outlined)
    ]
    -- yes, this is idiomatic multi-line list formatting in Haskell!

testExampleSets :: Bool
testExampleSets = all (\(c1, c2, c3) -> isSet c1 c2 c3) exampleSets

exampleNotSets :: [(Card, Card, Card)]
exampleNotSets =
    [ (Card Diamond Green One Solid, Card Diamond Purple One Outlined, Card Diamond Red One Outlined)
    , (Card Squiggle Red Two Solid, Card Squiggle Red Two Striped, Card Squiggle Green Two Outlined)
    ]

testExampleNotSets :: Bool
testExampleNotSets = not $ any (\(c1, c2, c3) -> isSet c1 c2 c3) exampleNotSets
    -- not any, is what you want here

testAll :: Bool
testAll = testExampleSets && testExampleNotSets

puzzle20121229 :: [String]
puzzle20121229 = [ "Op1#", "Sp1#", "Or3@", "Or1#"
                 , "Dg1#", "Or2=", "Or1=", "Dr1#"
                 , "Dg2@", "Sp1@", "Sg2=", "Sr1#"
                 ]