Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 59 lines (49 sloc) 1.61 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
module Jack where

data Tell = Lie | CanLie | Truth
data State = Mad | Sane
data Card = Ace | Two | Three | Four | Five | Six | Seven | Jack
data About = About

mad some = some `only` Lie --|| some `can` Lie
sane some = some `only` Truth --|| some `can` Truth

only :: Card -> Tell -> Bool
only card tell =
    foldl (&&) True (rumours card tell)

can :: Card -> Tell -> Bool
can card tell =
    foldl (||) False (rumours card tell)
    
rumours :: Card -> Tell -> [Bool]
rumours card tell =
    map (\other -> is card tell About other) (tell_about card)

is :: Card -> Tell -> About -> Card -> Bool
is card Lie About other = think card other Sane == mad other && think card other Mad == sane other
is card Truth About other = not (is card Lie About other)


think :: Card -> Card -> State -> Bool
think Three Ace Mad = True
think Seven Five Mad = True
think Six Ace Sane = True
think Six Two Sane = True
think Four Three Mad = sane Two
think Four Two Mad = sane Three
think Four Three Sane = True
think Four Two Sane = True
think Five Ace Mad = mad Four
think Five Four Mad = mad Ace
think Five Ace Sane = sane Four
think Five Four Sane = sane Ace
think Jack Six Mad = sane Seven
think Jack Seven Mad = sane Six
think Jack Six Sane = True
think Jack Seven Sane = True
think card other state =
    not $ think card other (not' state)

not' :: State -> State
not' Sane = Mad
not' Mad = Sane

tell_about :: Card -> [Card]
tell_about Three = [Ace]
tell_about Seven = [Five]
tell_about Six = [Ace,Two]
tell_about Four = [Three,Two]
tell_about Five = [Ace,Four]
tell_about Jack = [Six,Seven]
tell_about _ = []
Something went wrong with that request. Please try again.