[Haskell] Пример полезного кода

nikola1956

Сегодня продолжил изучение Haskell. :)
Для этого решил написать маленькое, но полезное приложение. Это редактор текстов, который выравнивает строки входного текстового файла по заданной ширине и сохраняет результат в новом файле. При этом должны сохраняться абзацы, чтобы пользователю было удобно читать отформатированный таким образом текст.
Приложение FormText.exe запускается из командной строки Windows так:


>FormText  70  in.txt  out.txt

Здесь число 70 — это требуемая ширина текста.
Возможно, участникам раздела Development будет интересно решение этой задачи на Haskell-e. Весь проект состоит из четырех модулей (файлов) и компилируется с помощью ghc в готовый exe-файл, весом 1,3 Мб.
Main.hs 


module Main where



import System.Environment (getArgs)

import FormText



interactWith function width inputFile outputFile = do

  input <- readFile inputFile

  writeFile outputFile (function (read width) input)

  

main = mainWith myFunction where

  mainWith function = do 

    args <- getArgs

    case args of

      [width,input,output] -> interactWith function width input output

      _ -> putStrLn "error: exactly three arguments needed"



myFunction :: Int -> String -> String

myFunction n s = formText n s

FormText.hs 


module FormText where



import SplitLine

import GroupWords



formText n s = unlines (concat ( map f (lines s)  where

  f :: String -> [String]

  f s = shortLines n s



shortLines :: Int -> String -> [String]  

shortLines n [] =[]

shortLines n x = 

  let (spaces, s) = firstSpaces x

      res = splitLine s 

  in let words = (spaces ++ (safeHead res : (safeTail res)

     in map sumWithSpace ( groupWords n words ) 

        where sumWithSpace xs = wordSum xs " "

		

wordSum :: [String] -> String -> String

wordSum [] a = []

wordSum [x] a = x

wordSum (x : xs) a = x ++ a ++ (wordSum xs a)			



		

safeHead :: [[a]] -> [a]

safeHead list = 

  if (null list)

  then []

  else head list

  

safeTail ::  [[a]] -> [[a]]

safeTail list =

  if (null list)

  then []

  else tail list

GroupWords.hs 


module GroupWords where



groupWords :: Int -> [String] -> [[String]]

groupWords n [] = []

groupWords n xs = 

  let (pre, suf) = break isLarge xs where isLarge s = (length s) > n

  in case (pre, suf) of

       (_, []) -> group n xs

       (start, large : rest) -> (group n start) ++ ( [large] : (groupWords n rest) ) 

  

group :: Int -> [String] -> [[String]]

group n [] = []

group n xs = 

  let (first, second) = firstGroup n xs

  in first : (group n second)



  

firstGroup :: Int -> [String] -> ([String], [String])

firstGroup n [] = ([],[])

firstGroup n xs = 

  let x = head xs 

  in if length x > n 

     then ( [], xs )

     else let (first, second) = firstGroup ( n - (length x) ) (tail xs)

	  in ( x : first, second )

SplitLine.hs 


module SplitLine where



splitLine :: String -> [String]

splitLine [] = []

splitLine s = 

  let (w, ws) = break isSpace s where isSpace c = c == ' '

  in case (w, ws) of

       ([], ' ' : rest ) -> splitLine rest 

       ( _, ' ' : rest ) -> w : (splitLine rest)

       ( s, [] ) -> [s] 



firstSpaces :: String -> (String, String)

firstSpaces [] =([], [])

firstSpaces ( ' ' : rest ) = let (start, end) = firstSpaces rest

                             in ( (' ' : start end) 

firstSpaces s = ([], s)

Всё это пишется в течении двух-трех часов, причем для человека мало знакомого с Haskell-ем. С помощью интерпретатора ghci можно удобно находить глюки в приложении, тестируя по отдельности каждую из "чистых" функций.
К сожаления, я еще не настроил IDE, поэтому, когда писал код в Notepad++, не хватало возможностей автоматического рефакторинга (переименование переменных и т.п.).
 

svetaslav212

А зачем такое писать на Haskell, когда можно на Perl? :confused:

nikola1956

Пример работы приложения:
in.txt
=============================
Прадеда Красовых, прозванного на дворне Цыганом, затравил борзыми барин Дурново. Цыган отбил у него, у своего господина, любовницу. Дурново приказал вывести Цыгана в поле, за Дурновку, и посадить на бугре. Сам же выехал со сворой и крикнул: "Ату его!" Цыган, сидевший в оцепенении, кинулся бежать. А бегать от борзых не следует.
   Деду Красовых удалось получить вольную. Он ушел с семьей в город - и скоро прославился: стал знаменитым вором. Нанял в Черной Слободе хибарку для жены, посадил ее плести на продажу кружево, а сам, с каким-то мещанином Белокопытовым, поехал по губернии грабить церкви. Когда его поймали, он вел себя так, что им долго восхищались по всему уезду: стоит себе будто бы в плисовом кафтане и в козловых сапожках, нахально играет скулами, глазами и почтительнейше сознается даже в самом малейшем из своих несметных дел:
   - Так точно-с. Так точно-с.
   А родитель Красовых был мелким шибаем. Ездил по уезду, жил одно время в родной Дурновке, завел было там лавочку, но прогорел, запил, воротился в город и помер. Послужив по лавкам, торгашили и сыновья его, Тихон и Кузьма.
=============================
out.txt (Ширина — 50 букв)
=============================
Прадеда Красовых, прозванного на дворне Цыганом,
затравил борзыми барин Дурново. Цыган отбил у него, у
своего господина, любовницу. Дурново приказал вывести
Цыгана в поле, за Дурновку, и посадить на бугре. Сам же
выехал со сворой и крикнул: "Ату его!" Цыган, сидевший в
оцепенении, кинулся бежать. А бегать от борзых не следует.
   Деду Красовых удалось получить вольную. Он ушел с
семьей в город - и скоро прославился: стал знаменитым
вором. Нанял в Черной Слободе хибарку для жены, посадил ее
плести на продажу кружево, а сам, с каким-то мещанином
Белокопытовым, поехал по губернии грабить церкви. Когда
его поймали, он вел себя так, что им долго восхищались по
всему уезду: стоит себе будто бы в плисовом кафтане и в
козловых сапожках, нахально играет скулами, глазами и
почтительнейше сознается даже в самом малейшем из своих
несметных дел:
   - Так точно-с. Так точно-с.
   А родитель Красовых был мелким шибаем. Ездил по уезду,
жил одно время в родной Дурновке, завел было там лавочку, но
прогорел, запил, воротился в город и помер. Послужив по
лавкам, торгашили и сыновья его, Тихон и Кузьма.
=============================

karkar

Некоторые функции уже есть в стандартной библиотеке. Cм. words, unwords из Prelude, intercalate из Data.List.
Кое-что можно сократить и упростить, заменив if на паттерн-матчинг. Например,
 
safeHead :: [[a]] -> [a]

safeHead [] = []

safeHead (x:xs) = x

nikola1956

Некоторые функции уже есть в стандартной библиотеке. Cм. words, unwords из Prelude, intercalate из Data.List.
Не знал, спасибо за комментарий! :)
Нужно будет посмотреть стандартные библиотеки Haskell-я.
Сейчас, пока что изучаю Haskell по книге "Real World Haskell" (Sullivan, Goerzen, Stewart, 2009 читаю все главы подряд, начиная с первой. Среди всех книг по Haskell-ю, которые я сумел найти в интернете, эта мне понравилась больше всего :)

doublemother

Это редактор текстов, который выравнивает строки входного текстового файла по заданной ширине и сохраняет результат в новом файле. При этом должны сохраняться абзацы, чтобы пользователю было удобно читать отформатированный таким образом текст.
vim file.txt
gqG
ZZ
Прадеда Красовых, прозванного на дворне Цыганом,                                                                                                                                                 

затравил борзыми барин Дурново. Цыган отбил у

него, у своего господина, любовницу. Дурново

приказал вывести Цыгана в поле, за Дурновку, и

посадить на бугре. Сам же выехал со сворой и

крикнул: "Ату его!" Цыган, сидевший в оцепенении,

кинулся бежать.  А бегать от борзых не следует.



   Деду Красовых удалось получить вольную. Он ушел

с семьей в город - и скоро прославился: стал

знаменитым вором. Нанял в Черной Слободе хибарку

для жены, посадил ее плести на продажу кружево, а

сам, с каким-то мещанином Белокопытовым, поехал по

губернии грабить церкви. Когда его поймали, он вел 

себя так, что им долго восхищались по всему уезду:

стоит себе будто бы в плисовом кафтане и в 

козловых сапожках, нахально играет скулами,

глазами и почтительнейше сознается даже в самом

малейшем из своих несметных дел:



   - Так точно-с. Так точно-с.



   А родитель Красовых был мелким шибаем. Ездил по

уезду, жил одно время в родной Дурновке, завел

было там лавочку, но прогорел, запил, воротился в

город и помер. Послужив по лавкам, торгашили и

сыновья его, Тихон и Кузьма.

kokoc88

vim file.txt
gqG
ZZ
Haskell выучить проще... ;)

Dimon89

Если тебе это надо с практической точки зрения, то любой нормальный текстовый редактор это умеет.
Notepad++ : TextFX -> TextFx Edit -> Rewrap Text to..
Если просто для изучения хаскеля, то задача неплохая. Допиши ещё тогда автораспознавание и красивое оформление заголовков (они идут капсом ну или выделяются пустыми строками) и диалогов =)

nikola1956

Продолжив изучение Haskell-я по книге "Real World Haskell", я решил существенно упростить и улучшить предыдщий код.
Прежде всего (следуя рекомендациям книги) нужно было избавиться от хвостовых рекурсий там, где это возможно, и вместо них постараться использовать стандартные функции вроде map, filter и т.п., а если это не удается, использовать fold-ы (foldl и foldr). Математическое определение левого и правого fold-ов я дал в из раздела Study.
Далее, я уменьшил объем кода и улучшил его читаемость за счет использования карринга.
Напомню, что карринг - это биекция вида [math]$C^{A\times B} \sim (C^{A})^{B}$[/math]. Особенно активно карринг используется в функции shortLines модуля FormText:
FormText 


module FormText where



import Util

import GroupWords



formText n s = unlines( concat( map (shortLines n) (lines s) ) )



shortLines :: Int -> String -> [String]  

shortLines n [] =[]

shortLines n x = 

  let (spaces, s) = span (' ' ==) x

      res = splitLine s 

      words = (spaces ++ (sfHead res : (sfTail res)

  in map (wordSum " ") ( groupWords n words ) 



  

wordSum :: String -> [String]  -> String

wordSum a = foldr step [] where

  step x sum | null sum = x 

             | otherwise = x ++ a ++ sum

			 

splitLine :: String -> [String]

splitLine s = foldr step [] s where

  step c xs | c == ' ' = [] : xs 

            | otherwise = (c : sfHead xs) : (sfTail xs)

Модуль Main.hs остался без изменения. Приведу здесь оставшиеся модули этой версии приложения.
GroupWords 


module GroupWords where



import Util

import Data.List



groupWords :: Int -> [String] -> [[String]]

groupWords n xs = foldl' step [] xs where

  step yss s = 

    let last = sfLast yss

	in if (sumLength last) + (length s) + (numSpaces last) + 1 <= n

	   then ( sfInit yss ) ++ [ last ++ [s] ]

	   else yss ++ [[s]]

		 

sumLength :: [String] -> Int

sumLength = foldr step 0 where

  step x len = (length x) + len 



numSpaces :: [String] -> Int

numSpaces = foldr step (-1) where

  step x sp | null x =  sp

            | otherwise = sp + 1

Util


module Util where

			 

sfHead :: [[a]] -> [a]

sfHead [] = []

sfHead xs = head xs

  

sfTail ::  [[a]] -> [[a]]

sfTail [] = []

sfTail xs = tail xs



sfLast :: [[a]] -> [a]

sfLast [] = []

sfLast xs = last xs



sfInit :: [[a]] -> [[a]]

sfInit [] = []

sfInit xs = init xs

digenet

Можешь написать прогу, которая бы подсчитвала файлы в дереве папок по расширениям(если интересно конечно же)?
Что-то типа этого:
count.exe dir:
...
dir :
*.txt 120
*.exe 15
*.zip 1500
...
----
subdir1:
*.txt x1
 *.exe y1
 *.zip z1
---
subdir2:
*.txt x2
 *.exe y2
 *.zip z2
----
..

nikola1956

Да, задача интересная. В книге, которую изучаю, есть целая глава, посвященная системному программированию на хаскеле, в том числе работе с файловой системой.

ppplva

Что там понимают под системным программированием? Кроме подсчета файлов в папках, конечно.

nikola1956

 
Что там понимают под системным программированием?

Это можно узнать по ссылке :
http://pv.bstu.ru/flp/RealWorldHaskell.pdf
Глава 20 :)
=======================================
20. Systems Programming in Haskell . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 467
Running External Programs 467
Directory and File Information 468
Program Termination 469
Dates and Times 470
ClockTime and CalendarTime 470
File Modification Times 475
Extended Example: Piping 476
Using Pipes for Redirection 477
Better Piping 483
Final Words on Pipes 491
=======================================

nikola1956

Вот, по-быстрому написал код, который считает количество exe-шников в заданной директории (и во всех вложенных в нее директориях). "Оформлением" я не занимался, поэтому пути к папкам нужно писать с двумя слешами:


>FileCount "C:\\Haskell\\"

Приложение FileCount.exe весит 1,1 Мб и как обычно запускается из командной строки Windows.
Весь исходный код этого приложения выглядит так:
Main


module Main where



import System.Environment (getArgs)

import Control.Monad (forM)

import System.Directory (doesDirectoryExist, getDirectoryContents)

import System.FilePath </> takeExtension)



main = do 

  args <- getArgs

  case args of

    [input] -> interactWith input 

    _ -> putStrLn "error: exactly one argument needed"

	

interactWith folder = do

  tree <- createTree folder

  putStrLn ( show (count tree) )

  

createTree :: String -> IO (Tree String)

createTree topdir = do

  rawNames <- getDirectoryContents topdir

  let names = filter (`notElem` [".", ".."]) rawNames

  subTrees <- forM names $ \name -> do

    let path = topdir </> name

    isDir <- doesDirectoryExist path

    if isDir

    then createTree path

    else return (Tree path [])

  return (Tree topdir subTrees) 

  

data Tree a = Tree a [Tree a]

              deriving (Show)



count :: Tree String -> Int 

count (Tree s []) | takeExtension s == ".exe" = 1

                  | otherwise = 0

count (Tree s xs) = sum( map count xs )

Здесь единственное сложное место — это использование монады forM. Конкретно в этом примере понятно, в чем смысл монады, но с тем, что такое монада вообще, я, честно говоря, пока не разобрался.
 
Оставить комментарий
Имя или ник:
Комментарий: