import Control.Concurrent (
  Chan,
  ThreadId,
  forkIO,
  newChan,
  readChan,
  threadDelay,
  writeChan,
 )
import Control.Monad (forM, forever, void)

-- forkIO -- Creates a thread
-- newChan -- Creates a new channel
-- writeChan -- Writes to the channel's message queue
-- readChan -- Reads from the channel. Blocks if the channel is empty

messageExample :: IO ()
messageExample = do
  c <- newChan
  forkIO $ forever $ do
    x <- readChan c
    putStrLn $ "Received: " ++ x
  writeChan c "42"
  writeChan c "43"
  pure ()

messageExample2 :: IO ()
messageExample2 = do
  c <- newChan
  let threadLoop c = do
        x <- readChan c
        putStrLn $ "Received: " ++ x
        threadLoop c
  forkIO $ threadLoop c
  writeChan c "42"
  writeChan c "43"
  pure ()

-- Single reader principle
-- A channel shall only be read by one thread, yet can be written by multiple

---- IncServer BEGIN

data Msg = MsgInc Int (Chan Int) | MsgSet Int

newServer :: IO IncServer
newServer = do
  c <- newChan
  let threadLoop state = do
        msg <- readChan c
        case msg of
          MsgInc n rc -> do
            writeChan rc state
            threadLoop $ state + n
          MsgSet n -> threadLoop n
  forkIO $ threadLoop 0
  pure $ IncServer $ c

data IncServer = IncServer (Chan Msg)

-- This is an RPC operation
serverInc :: IncServer -> Int -> IO Int
serverInc (IncServer c) n = do
  rc <- newChan
  writeChan c $ MsgInc n rc
  readChan rc

-- This is an asynchronous operation
serverSet :: IncServer -> Int -> IO ()
serverSet (IncServer c) = writeChan c . MsgSet

usage :: IO ()
usage = do
  s <- newServer
  forM [1 .. 10] $ \i ->
    forkIO $ void $ serverInc s i
  serverSet s 0
  r <- serverInc s 0
  putStrLn $ show r

---- IncServer END

---- GenServer BEGIN

-- ørlæng (cursed)

data Server msg = Server ThreadId (Chan msg)

spawn :: (Chan msg -> IO ()) -> IO (Server msg)
spawn f = do
  c <- newChan
  fid <- forkIO $ f c
  pure $ Server fid c

send :: Chan msg -> msg -> IO ()
send = writeChan

receive :: Chan msg -> IO msg
receive = readChan

-- asynchronous
sendTo :: Server msg -> msg -> IO ()
sendTo (Server _ c) msg = send c msg

data ReplyChan a = ReplyChan (Chan a)

reply :: ReplyChan a -> a -> IO ()
reply (ReplyChan c) = send c

requestReply :: Server msg -> (ReplyChan a -> msg) -> IO a
requestReply server mkMsg = do
  rc <- newChan
  let msg = mkMsg $ ReplyChan rc
  sendTo server msg
  receive rc

---- GenServer END

---- IncServer based on GenServer BEGIN

data ISGMsg
  = ISGMsgInc Int (ReplyChan Int)
  | ISGMsgSet Int

data ISGServer = ISGServer (Server ISGMsg)

newISGServer :: IO ISGServer
newISGServer = do
  let serverLoop state c = do
        msg <- receive c
        case msg of
          (ISGMsgInc a rc) -> do
            reply rc state
            serverLoop (state + a) c
          (ISGMsgSet a) -> serverLoop a c
  ISGServer <$> (spawn $ serverLoop 0)

serverInc' :: Int -> ISGServer -> IO Int
serverInc' x (ISGServer server) = requestReply server (ISGMsgInc x)

serverSet' :: Int -> ISGServer -> IO ()
serverSet' n (ISGServer server) = sendTo server $ ISGMsgSet n

---- IncServer based on GenServer END

usage' :: IO ()
usage' = do
  s <- newISGServer
  serverSet' 3 s
  serverSet' 4 s
  _ <- serverInc' 4 s
  _ <- serverInc' 4 s
  r <- serverInc' 4 s
  putStrLn $ show r

type Timeout = Int

readWithTimeout :: Chan a -> Timeout -> IO (Maybe a)
readWithTimeout chan timeout = do
  -- tc :: Chan (Maybe a)
  tc <- newChan
  forkIO $ threadDelay timeout >> writeChan tc Nothing
  forkIO $ readChan chan >>= writeChan tc . Just
  readChan tc

usage'' :: IO ()
usage'' = do
  c <- newChan
  forkIO $ do
    threadDelay 10000000000
    writeChan c 123
  x <- readWithTimeout c 1000000
  print x

-- Our job as computer scientists is to take programs that are """exciting""", and make them somehow less """exciting"""

-- I'm not judging you on taste (in this course)

-- Space