import Control.Concurrent
import Control.Monad

data Knob = Turned | Unturned
data ExtensionDoor e = Opened Knob e | Closed Knob e

class Door a where
  createDoor :: IO a
  isOpen, isClose, canBeOpened :: a -> IO Bool
  pull, push, knobTurn, knobUnturn :: a -> IO ()

  isClose door = return . not =<< (isOpen door)

type Ordinary = ()
newtype OrdinaryDoor = OrdinaryDoor (MVar (ExtensionDoor Ordinary))

instance Door (OrdinaryDoor) where
  createDoor = do
    m <- newMVar (Closed Unturned ())
    return (OrdinaryDoor m)
  isOpen (OrdinaryDoor m) = do
    door <- takeMVar m
    putMVar m door
    return $ case door of
      Opened _ _-> True
      _ -> False
  
  canBeOpened (OrdinaryDoor m) = do
    door <- takeMVar m
    putMVar m door
    return $ case door of
      Closed Turned _ -> True
      _ -> False

  pull (OrdinaryDoor m) = do
    _ <- takeMVar m
    putMVar m (Closed Unturned ())

  push (OrdinaryDoor m) = do
    door <- takeMVar m
    putMVar m $ case door of
      Closed Turned _ -> Opened Unturned ()
      _ -> door

  knobTurn (OrdinaryDoor m) = do
    door <- takeMVar m
    putMVar m $ case door of
      Closed Unturned _ -> Closed Turned ()
      Opened Unturned _ -> Opened Turned ()
      _ -> door

  knobUnturn (OrdinaryDoor m) = do
    door <- takeMVar m
    putMVar m $ case door of
      Closed Turned _ -> Closed Unturned ()
      _ -> door


test1 :: IO ()
test1 = do
  door <- createDoor :: IO OrdinaryDoor
  putStrLn "door is a Door"

  knobTurn door 
  putStrLn . ("knobTurn door; canBeOpened door => " ++) . show =<< canBeOpened door

  knobUnturn door
  putStrLn . ("knobUnturn door; canBeOpened door => " ++) . show =<< canBeOpened door

  push door
  putStrLn . ("push door; isOpen door => " ++) . show =<< isOpen door

  knobTurn door
  push door
  putStrLn . ("knobTurn door; push door; isOpen door => " ++) . show =<< isOpen door

  pull door
  putStrLn . ("push door; isOpen door => " ++) . show =<< isOpen door
  putStrLn . ("canBeOpened door => " ++) . show =<< canBeOpened door

main :: IO ()
main = test1