typedef struct StgTSO_ {
    StgHeader               header;
    struct StgTSO_*         _link;
    struct StgTSO_*         global_link;
    struct StgStack_       *stackobj;

    StgWord16               what_next;
    StgWord16               why_blocked;
    StgWord32               flags;
    StgTSOBlockInfo         block_info;
    StgThreadID             id;
    StgWord32               saved_errno;
    StgWord32               dirty;
    struct InCall_*         bound;
    struct Capability_*     cap;

    ...

} *StgTSOPtr;
// StgTSO defined in rts/Types.h

-- главная функция
main :: IO ()  -- IO — функция работает с реальным миром, () — типа Unit, void
main = do
    s <- getLine  -- считать строку из консоли в переменную s
    putStrLn s    -- напечатать строку s в консоль

-- возвращает не просто строку, а показывает, что строка пришла из реального мира
getReversedLine :: IO String  
getReversedLine = do
    s <- getLine
    return (reverse s)

main :: IO ()
main = do
    rs <- getReversedLine
    putStrLn rs

forkIO :: IO () -> IO ThreadId  -- creates lightweight thread

module Main where

import System.Random      (randomRIO)
import Control.Concurrent (forkIO, threadDelay)

main :: IO ()
main = do
    forkIO delayAndPrint
    threadDelay (2 * 10^6)
    putStrLn "Main thread!"

delayAndPrint :: IO ()
delayAndPrint = do
    randomTime <- randomRIO (1, 3)
    threadDelay (randomTime * 10^6)  -- подождать указанное число микросекунд
    putStrLn "Forked thread!"

-- коробочка для данных; может быть в одном из двух состояний 
--   1. Пустая
--   2. Хранит данные типа `a`
data MVar a  

newEmptyMVar :: IO (MVar a)           -- создаёт новую пустую коробочку
newMVar      :: a -> IO (MVar a)      -- создаёт непустую коробочку с данными
putMVar      :: MVar a -> a -> IO ()  -- кладёт данные в коробочку
takeMVar     :: MVar a -> IO a        -- забирает данные из коробочки
readMVar     :: MVar a -> IO a        -- атомарно читает из коробочки, не забирая

-- аргументы функции: две коробочки строк
slowPut :: MVar String -> MVar String -> IO ()
slowPut mv1 mv2 = do 
    threadDelay (2 * 10^6)  -- ждём две секунды
    putStrLn "Put val 1"   
    putMVar mv1 "mv1 smth"  -- кладём в первую коробочку
    threadDelay (2 * 10^6)  -- ждём ещё две секунды
    putStrLn "Put val 2"
    putMVar mv2 "mv2 smth"  -- кладём во вторую коробочку

main :: IO ()
main = do 
    mv1 <- newEmptyMVar  -- создаём две пустые коробочки
    mv2 <- newEmptyMVar  

    forkIO $ do  -- выполняем в отдельном форке действия
        putStrLn "Start slowput"
        slowPut mv1 mv2

    r1 <- takeMVar mv1  -- ждём, пока положат в первую коробочку
    putStrLn ("Take first: " ++ r1)

    r2 <- takeMVar mv2  -- ждём, пока положат во вторую коробочку
    putStrLn ("Take second: " ++ r2)

module Main where  -- название файла: MVTest.hs

import Control.Concurrent.MVar (newEmptyMVar, takeMVar)

main :: IO ()
main = do
    m <- newEmptyMVar
    takeMVar m

$ stack ghc -- MVTest.hs
[1 of 1] Compiling Main             ( MVTest.hs, MVTest.o )
Linking MVTest ...

$ ./MVTest 
MVTest: thread blocked indefinitely in an MVar operation

endlessPain :: IO ()
endlessPain = do
    v <- newEmptyMVar  -- создаём пустую коробочку

    forkIO $ forever $ do  -- в отдельном треде выполняем действие бесконечно
        x <- takeMVar v
        putStrLn x

    putMVar v "Haskell"  -- кладём в коробочку всего два раза
    putMVar v "42"

main :: IO ()
main = do 
    endlessPain             -- вызываем определённую ранее функцию 
    threadDelay (5 * 10^6)  -- ждём 5 секунд
    putStrLn "After eternity"         

data ChItem a = ChItem a (Stream a)

type Stream a = MVar (ChItem a)

data Chan a = Chan (MVar (Stream a))
                   (MVar (Stream a)) -- Invariant: the `Stream a` 
                                     -- is always an empty MVar

data Async a  -- асинхронное вычисление, возвращающее объект типа `a`

async        :: IO a -> IO (Async a)             -- создать асинхронное вычисление
wait         :: Async a -> IO a                  -- подождать выполнения
cancel       :: Async a -> IO ()                 -- отменить вычисление
concurrently :: IO a -> IO b -> IO (a, b)        -- оба параллельно
race         :: IO a -> IO b -> IO (Either a b)  -- какое раньше

dummyWorker :: Int -> IO Int  -- делаем бесполезную работу (программируем)
dummyWorker n = do
    threadDelay (10^2 * n)
    return (n * n)

-- Запускаем два потока, делаем ставки на самый быстрый и ждём
raceTest :: IO (Either Int Int)
raceTest = race (worker 1000) (worker 2000)

-- Запускаем два треда и ждём выполнения обоих
test1 :: IO (Int, Int)
test1 = do val1 <- async $ worker 1000
           val2 <- async $ worker 2000
           res1 <- wait val1
           res2 <- wait val2
           return (res1, res2)

type Account = MVar Integer

credit :: Integer -> Account -> IO ()
credit amount account = do
    current <- takeMVar account
    putMVar account (current + amount)

debit :: Integer -> Account -> IO ()
debit amount account = do
    current <- takeMVar account
    putMVar account (current - amount)

transfer :: Integer 
         -> Account 
         -> Account 
         -> IO ()
transfer amount from to = do
    debit amount from
    credit amount to

type Account = TVar Integer

credit :: Integer -> Account -> STM ()
credit amount account = do
    current <- readTVar account
    writeTVar account (current + amount)

debit :: Integer -> Account -> STM ()
debit amount account = do
    current <- readTVar account
    writeTVar account (current - amount)

transfer :: Integer 
         -> Account 
         -> Account 
         -> STM ()
transfer amount from to = do
    debit amount from
    credit amount to