module Pinter.Ch03.CoinGame where

import Control.Arrow (first, second)
import Data.Group (Group (..))
import Data.Tuple (swap)

data Move
  = -- | Flip over the coin at A.
    M1
  | -- | Flip over the coin at B.
    M2
  | -- | Flip over both coins.
    M3
  | -- | Switch the coins.
    M4
  | -- | Flip coin at A; then switch.
    M5
  | -- | Flip coin at B; then switch.
    M6
  | -- | Flip both coins; then switch.
    M7
  | -- | Do not change anything.
    I
  deriving (Move -> Move -> Bool
(Move -> Move -> Bool) -> (Move -> Move -> Bool) -> Eq Move
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Move -> Move -> Bool
$c/= :: Move -> Move -> Bool
== :: Move -> Move -> Bool
$c== :: Move -> Move -> Bool
Eq, Int -> Move -> ShowS
[Move] -> ShowS
Move -> String
(Int -> Move -> ShowS)
-> (Move -> String) -> ([Move] -> ShowS) -> Show Move
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Move] -> ShowS
$cshowList :: [Move] -> ShowS
show :: Move -> String
$cshow :: Move -> String
showsPrec :: Int -> Move -> ShowS
$cshowsPrec :: Int -> Move -> ShowS
Show)

instance Semigroup Move where
  I <> :: Move -> Move -> Move
<> b :: Move
b = Move
b
  b :: Move
b <> I = Move
b
  M1 <> M1 = Move
I
  M1 <> M2 = Move
M3
  M1 <> M3 = Move
M2
  M1 <> M4 = Move
M5
  M1 <> M5 = Move
M4
  M1 <> M6 = Move
M7
  M1 <> M7 = Move
M6
  M2 <> M1 = Move
M3
  M2 <> M2 = Move
I
  M2 <> M3 = Move
M1
  M2 <> M4 = Move
M6
  M2 <> M5 = Move
M7
  M2 <> M6 = Move
M4
  M2 <> M7 = Move
M5
  M3 <> M1 = Move
M2
  M3 <> M2 = Move
M1
  M3 <> M3 = Move
I
  M3 <> M4 = Move
M7
  M3 <> M5 = Move
M6
  M3 <> M6 = Move
M5
  M3 <> M7 = Move
M4
  M4 <> M1 = Move
M6
  M4 <> M2 = Move
M5
  M4 <> M3 = Move
M7
  M4 <> M4 = Move
I
  M4 <> M5 = Move
M2
  M4 <> M6 = Move
M1
  M4 <> M7 = Move
M3
  M5 <> M1 = Move
M7
  M5 <> M2 = Move
M4
  M5 <> M3 = Move
M6
  M5 <> M4 = Move
M1
  M5 <> M5 = Move
M3
  M5 <> M6 = Move
I
  M5 <> M7 = Move
M2
  M6 <> M1 = Move
M4
  M6 <> M2 = Move
M7
  M6 <> M3 = Move
M5
  M6 <> M4 = Move
M2
  M6 <> M5 = Move
I
  M6 <> M6 = Move
M3
  M6 <> M7 = Move
M1
  M7 <> M1 = Move
M5
  M7 <> M2 = Move
M6
  M7 <> M3 = Move
M4
  M7 <> M4 = Move
M3
  M7 <> M5 = Move
M1
  M7 <> M6 = Move
M2
  M7 <> M7 = Move
I

instance Monoid Move where
  mempty :: Move
mempty = Move
I

instance Group Move where
  invert :: Move -> Move
invert M5 = Move
M6
  invert M6 = Move
M5
  invert x :: Move
x = Move
x

runMove :: Move -> (Bool, Bool) -> (Bool, Bool)
runMove :: Move -> (Bool, Bool) -> (Bool, Bool)
runMove M1 = (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Bool -> Bool
not
runMove M2 = (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Bool -> Bool
not
runMove M3 = Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M1 ((Bool, Bool) -> (Bool, Bool))
-> ((Bool, Bool) -> (Bool, Bool)) -> (Bool, Bool) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M2
runMove M4 = (Bool, Bool) -> (Bool, Bool)
forall a b. (a, b) -> (b, a)
swap
runMove M5 = Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M4 ((Bool, Bool) -> (Bool, Bool))
-> ((Bool, Bool) -> (Bool, Bool)) -> (Bool, Bool) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M1
runMove M6 = Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M4 ((Bool, Bool) -> (Bool, Bool))
-> ((Bool, Bool) -> (Bool, Bool)) -> (Bool, Bool) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M2
runMove M7 = Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M4 ((Bool, Bool) -> (Bool, Bool))
-> ((Bool, Bool) -> (Bool, Bool)) -> (Bool, Bool) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M1 ((Bool, Bool) -> (Bool, Bool))
-> ((Bool, Bool) -> (Bool, Bool)) -> (Bool, Bool) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Move -> (Bool, Bool) -> (Bool, Bool)
runMove Move
M2
runMove I = (Bool, Bool) -> (Bool, Bool)
forall a. a -> a
id