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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
#!/usr/bin/env stack
{- stack
   --resolver lts-12.0
   --install-ghc
   script
   --ghc-options -Werror
   --ghc-options -Wall
   --package echo
   --package random
   --
-}

--------------------------------------------------------------------------------

{-# LANGUAGE Safe #-}

--------------------------------------------------------------------------------

module Main (main) where

--------------------------------------------------------------------------------

import           Data.List
  ( sort
  )
import           Data.Maybe
  ( fromMaybe
  )
import           System.IO.Echo
  ( withoutInputEcho
  )
import           System.Random
  ( newStdGen
  , randomRs
  )
import           Text.Read
  ( readMaybe
  )

--------------------------------------------------------------------------------

-- The type `Box` should be moved to a common `library` used by both Bob and Ali
-- and it shouldn't expose the constructor `Box`. That way, we ensure that the
-- type `Box` can't implement an instance for `Show`.
--
-- Note: As this mimic a `physical` representation of `Boxes`, we aren't going
-- into further details on how to tranfer these `Boxes` over the wire.
newtype Box = Box { box :: (Integer, Ordering) }

type Boxes = [ Box ]
type Lower = Integer
type Upper = Integer

rands :: Int -> Lower -> Upper -> IO [ Integer ]
rands n l u =
  take n . randomRs (l,u) <$> newStdGen

action01 :: Integer -> IO Boxes
action01 x =
  -- Bob gives his labeled box to `UPS` at Location A. Afterwards, the driver
  -- takes further 10 boxes and randomly label them in the range (lower = x / 5,
  -- upper = x * 5), based on the amout `x` of Bobs fortune stated on his
  -- box. They drive the 11 boxes to Ali at Location B.
  map (Box . flip (,) undefined) . sort . (x:) <$> rands 10 l u
  where
    l = x `div` 5
    u = x   *   5

action02 :: Integer -> Boxes -> Boxes
action02 x =
  -- Ali, at Location B, put stickers (EQ,LT and GT) on all boxes based on her
  -- fortune compared to the values on each box. When this is done, the `UPS`
  -- driver, bring them all back to Bob at Location A.
  map $ Box . aux . box
  where
    aux = \(i,_) -> (i, compare x i)

action03 :: Integer -> Boxes -> Ordering
action03 x =
  -- Since Bob only knows the value of his Box, he can only request that to the
  -- driver of the `UPS` van. If he began to guess randomly and fails, the
  -- driver might get suspicious and will abort any delivery.
  snd . box . head . filter ((== x) . fst . box)

--------------------------------------------------------------------------------

main :: IO ()
main =
  putStr "Location A | Bob gives his box:   "   >>= \ _   ->
  help <$> withoutInputEcho (getLine)           >>= \ bob ->
  putStrLn "********"                           >>= \ _   ->
  putStr "Location B | Ali label the boxes: "   >>= \ _   ->
  help <$> withoutInputEcho (getLine)           >>= \ ali ->
  putStrLn "********"                           >>= \ _   ->
  action03 bob . action02 ali <$> action01 bob  >>= putStrLn . (info ++) . show
  where
    info = "Location A | Bob sees that Ali's fortune is: "
    help = fromMaybe 0 . readMaybe

user@personal:~/../ymp$ ./YaosMillionairesProblem.hs 
Location A | Bob gives his box:   ******** # Bobs fortune is 42
Location B | Ali label the boxes: ******** # Alis fortune is 84
Location A | Bob sees that Ali's fortune is: GT