VE>>mapM_ writeToFile lst
VE>>

{-# LANGUAGE GADTs  #-}

data IO_ a where
    WriteToFile :: String -> IO_ ()
    Sequence :: [IO_ ()] -> IO_ ()
    -- etc

writeAll xs = Sequence (map WriteToFile xs)


evalIO_ :: IO_ a -> IO a
evalIO_ = ...

def words = ["abba", "yield"];
foreach (group in words.GroupBy(w => w[0]))
  File.WriteAllText($"$(group.Key).txt", $"..$group");

a |> f = f a

-- сортирует длинный список
-- разбивает список на последовательные блоки, сортирует их, записывает во временные файлы, затем файлы читает и объединяет
bigSort :: (Read a, Ord a, Show a) => [a] -> IO [a]
bigSort xs = xs |> breakUp 10000 |> map sort |> writeChains >>= readChains >>= (merge >>> return)

-- сохраняет блоки во временные файлы, возвращает имена файлов, куда записал
writeChains chains = do
  let tempFiles = [1..] |> map show |> map ("temp"++)
  let writeChain' (filename, xs) = xs |> map show |> unlines |> writeFile filename >> return filename
  mapM writeChain' (zip tempFiles chains)

-- читает блоки из временных файлов
readChains files = do
  let readChain' file = readFile file >>= (lines >>> map read >>> return)
  mapM readChain' files

-- разбивает список на части размером size
breakUp :: Int -> [a] -> [[a]]
breakUp size xs = let takeBlock ps = guard (null ps |> not) >> Just (splitAt size ps) 
                  in unfoldr takeBlock xs

-- объединяет несколько упорядоченных списков в один упорядоченный список
merge :: (Ord a) => [[a]] -> [a]
merge [] = []
merge ss = foldl1 mergePair ss

mergePair [] ss = ss
mergePair ss [] = ss
mergePair (s1:ss1) (s2:ss2) | s1 <= s2  = s1 : mergePair ss1 (s2:ss2)
                            | otherwise = s2 : mergePair (s1:ss1) ss2

main = do 
  args <- getArgs
  let src = head args
  let dst = src ++ "_sorted"
  readFile src >>= (lines >>> bigSort) >>= (unlines >>> writeFile dst)

main2 = do
  args <- getArgs
  let src = head args
  let dst = src ++ "_sorted"
  let dup = src ++ "_dup"
  let needDup = any (=="-u") args

  sortedData <- readFile src >>= (lines >>> bigSort)

  hdst <- openFile dst WriteMode
  hdup <- openFile dup WriteMode

  -- количество одинаковых строк и сами эти строки
  let gs = [(length g, head g) | g <- group sortedData]
  -- пишем параллельно в sorted и dup
  let writeGroup (count, str) = do
        replicateM_ count (hPutStrLn hdst str) 
        if needDup then hPutStrLn hdup (show count ++ ": " ++ str) else return ()
  mapM_ writeGroup [(length g, head g) | g <- group sortedData]
 
  hClose hdup
  hClose hdst

a |> f = f a

-- сортирует длинный список
-- разбивает список на последовательные блоки, сортирует их, записывает во временные файлы, затем файлы читает и объединяет
bigSort :: (Read a, Ord a, Show a) => [a] -> IO [a]
bigSort xs = xs |> breakUp 10000 |> map sort |> writeChains >>= readChains >>= (merge >>> return)

-- сохраняет блоки во временные файлы, возвращает имена файлов, куда записал
writeChains chains = do
  let tempFiles = [1..] |> map show |> map ("temp"++)
  let writeChain' (filename, xs) = xs |> map show |> unlines |> writeFile filename >> return filename
  mapM writeChain' (zip tempFiles chains)

-- читает блоки из временных файлов
readChains files = do
  let readChain' file = readFile file >>= (lines >>> map read >>> return)
  mapM readChain' files

-- разбивает список на части размером size
breakUp :: Int -> [a] -> [[a]]
breakUp size xs = let takeBlock ps = guard (null ps |> not) >> Just (splitAt size ps) 
                  in unfoldr takeBlock xs

-- объединяет несколько упорядоченных списков в один упорядоченный список
merge :: (Ord a) => [[a]] -> [a]
merge [] = []
merge ss = foldl1 mergePair ss

mergePair [] ss = ss
mergePair ss [] = ss
mergePair (s1:ss1) (s2:ss2) | s1 <= s2  = s1 : mergePair ss1 (s2:ss2)
                            | otherwise = s2 : mergePair (s1:ss1) ss2

main = do 
  args <- getArgs
  let src = head args
  let dst = src ++ "_sorted"
  readFile src >>= (lines >>> bigSort) >>= (unlines >>> writeFile dst)

main2 = do
  args <- getArgs
  let src = head args
  let dst = src ++ "_sorted"
  let dup = src ++ "_dup"
  let needDup = any (=="-u") args

  sortedData <- readFile src >>= (lines >>> bigSort)

  hdst <- openFile dst WriteMode
  hdup <- openFile dup WriteMode

  -- количество одинаковых строк и сами эти строки
  let gs = [(length g, head g) | g <- group sortedData]
  -- пишем параллельно в sorted и dup
  let writeGroup (count, str) = do
        replicateM_ count (hPutStrLn hdst str) 
        if needDup then hPutStrLn hdup (show count ++ ": " ++ str) else return ()
  mapM_ writeGroup [(length g, head g) | g <- group sortedData]
 
  hClose hdup
  hClose hdst

main = do -- (Лениво) создаём отсортированные подсписки
          sublists <- fmap sort1 getContents
          -- Записываем их в файлы с именами 1..n
          zipWithM_ writeFile (map show [1..]) sublists
          -- Читаем (опять же лениво) содержимое всех ранее созданных файлов
          sublists <- mapM (fmap lines readFile.show) [1..length sublists]
          -- Сливаем их и записываем результат
          putStr (unlines (mergesort' compare sublists)

BZ>на самом деле, даже если я ни в чём не ошибся — этот код будет держать все данные в памяти до победного. extra points — за изящное решение этой маааленькой проблемы

main = do -- (Лениво) создаём отсортированные подсписки
          sublists <- fmap sort1 getContents
          -- Записываем их в файлы с именами 1..n
          count <- fmap length $ zipWithM writeFile (map show [1..]) sublists
          -- Читаем (опять же лениво) содержимое всех ранее созданных файлов
          sublists <- mapM (fmap lines readFile.show) [1..count]
          -- Сливаем их и записываем результат
          putStr (unlines (mergesort' compare sublists)

(*базовый вещи *)
open ExtString;;
let (|>) x f = f x;;
let (>>) f g x = g (f x);;

(* структура с информацией о файле *)
type file_t = { name : string; size : int; ext : string };;

(* структура-аккумулятор с текущим блоком файлов *)
type accum_t = { files : file_t list; num : int; totalsize : int};;
let new_acc = { files = []; num = 0; totalsize = 0 };; (* пустой блок *)
let accumulate acc file =
  { files = file::acc.files; num = acc.num + 1; totalsize = acc.totalsize + file.size };;

(* разбор строки параметров *)
let parse_param_string str =
  let numparam ch =
    let rec loop i lst =
      if i<0 then lst else
      if str.[i]>='0' && str.[i]<='9' then loop (i-1) (str.[i] :: lst) else lst  in
    try Some (loop (String.index str ch - 1) [] |> String.implode |> int_of_string)
    with Not_found -> None  in
  numparam 'f', numparam 'b', String.contains str 'e';;

(* основная функция. из списка файлов делает список списков файлов согласно параметрам из строки *)
let make_blocks param_str file_list =
  if param_str = "" then [file_list] else (* простая оптимизация, можно и без нее *)
  let num_opt, size_opt, ext_opt = parse_param_string param_str in (* разбираем параметры *)
  (* создаем предикаты, говорящие можно ли поместить файл в текущий блок *)
  let always = (fun acc file -> true) in
  let size_pred = Option.map_default (fun size_limit -> (fun a f-> a.totalsize + f.size <= size_limit)) always size_opt
  and ext_pred = if ext_opt then (fun a f -> if a.num > 0 then (List.hd a.files).ext = f.ext else true) else always
  and num_pred =  Option.map_default (fun num_limit  -> (fun a f-> a.num + 1 <= num_limit)) always num_opt in 
  (* можно, если все три предиката не возражают *)
  let can_accum = (fun acc file -> List.for_all (fun pred-> pred acc file) [ext_pred; size_pred; num_pred]) in
  (* обработка одного файла: *)
  let process (acc, res_list) file =
    if can_accum acc file then accumulate acc file, res_list
    else accumulate new_acc file, (acc::res_list)  in  
  (* обработка всего списка: собираем новый список fold'ом, разворачиваем и убираем лишнее rev_map'ом *)
  let acc, reslst = List.fold_left process (new_acc, []) file_list in
  acc::reslst |> List.rev_map (fun acc-> List.rev acc.files);;

let allfiles = [
  { name = "a"; size = 10; ext = "jpg" };
  { name = "b"; size = 20; ext = "jpg" };
  { name = "c"; size = 40; ext = "bmp" };
  { name = "d"; size = 35; ext = "jpg" };
  { name = "e"; size = 10; ext = "bmp" };
  { name = "f"; size = 60; ext = "gif" };
  { name = "g"; size = 45; ext = "gif" };
  { name = "h"; size = 20; ext = "gif" };
  { name = "i"; size = 15; ext = "jpg" };
  { name = "j"; size = 60; ext = "gif" };
  { name = "k"; size = 25; ext = "jpg" };
  { name = "l"; size = 20; ext = "gif" };
];; 
 
let show_file file =
  Printf.sprintf "(%s.%s %d)" file.name file.ext file.size;;

let show =
  List.map (List.map show_file >> String.join ", ") >> String.join "\n";;   
      
make_blocks "4f105b" allfiles |> show |> print_endline;;

(*выводит:
(a.jpg 10), (b.jpg 20), (c.bmp 40), (d.jpg 35)
(e.bmp 10), (f.gif 60)
(g.gif 45), (h.gif 20), (i.jpg 15)
(j.gif 60), (k.jpg 25), (l.gif 20)
*)

make_blocks "e" allfiles |> show |> print_endline;;

(*выводит:
(a.jpg 10), (b.jpg 20)
(c.bmp 40)
(d.jpg 35)
(e.bmp 10)
(f.gif 60), (g.gif 45), (h.gif 20)
(i.jpg 15)
(j.gif 60)
(k.jpg 25)
(l.gif 20)
*)