环境配置

基础

进入交互模式

$ stack exec -- ghci

装载脚本

Prelude> :l Main.hs

编译程序

PS C:\Users\VGalaxy> stack ghc Main.hs

或

vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy$ ghc --make Main

执行程序

$ ./Main

列表和元组

列表

单类型数据结构

拼接

Prelude> [1,2,3,4] ++ [9,10,11,12]
[1,2,3,4,9,10,11,12]

构建

Prelude> 1:2:[]
[1,2]
Prelude> 'a':'b':[]
"ab"

字符串只是字符列表的语法糖

索引

Prelude> [1,2,3] !! 2
3

区间

Prelude> [1..20]
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
Prelude> [1,3..20]
[1,3,5,7,9,11,13,15,17,19]

列表推导

Prelude> [x*y|x<-[2,5,10],y<-[8,10,11],x*y>50]
[55,80,100,110]
Prelude> let xxs = [[1,3,5,2,3,1,2,4,5],[1,2,3,4,5,6,7,8,9],[1,2,4,2,1,6,3,1,3,2,3,6]]
Prelude> [[x|x<-xs,even x]|xs<-xxs]
[[2,2,4],[2,4,6,8],[2,4,2,6,2,6]]

元组

异构、长度固定

Prelude> fst (8,11)
8
Prelude> snd (8,11)
11
Prelude> zip [1,2,3,4,5] [5,5,5,5,5]
[(1,5),(2,5),(3,5),(4,5),(5,5)]

函数

函数调用

Prelude> div 3 1
3
Prelude> 3 `div` 1
3
Prelude> 3 == 3.0
True
Prelude> (==) 3 3.0
True

条件分支

doubleSmallNumber x = if x > 100 then x else x*2
doubleSmallNumber' x = (if x > 100 then x else x*2) + 1

模式匹配

factorial :: (Integral a) => a -> a
factorial 0 = 1
factorial n = n * factorial (n - 1)

元组的模式匹配

first :: (a, b, c) -> a
first (x, _, _) = x
second :: (a, b, c) -> b
second (_, y, _) = y
third :: (a, b, c) -> c
third (_, _, z) = z

列表的模式匹配

tell :: (Show a) => [a] -> String
tell [] = "The list is empty"
tell (x:[]) = "The list has one element: " ++ show x
tell (x:y:[]) = "The list has two elements: " ++ show x ++ " and " ++ show y
tell (x:y:_) = "This list is long. The first two elements are: " ++ show x ++ " and " ++ show y

as-pattern

capital :: String -> String
capital "" = "Empty string, whoops!"
capital all@(x:xs) = "The first letter of " ++ all ++ " is " ++ [x]

guard

myCompare :: (Ord a) => a -> a -> Ordering
a `myCompare` b
    | a > b = GT
    | a == b = EQ
    | otherwise = LT

myCompare' :: (Ord a) => a -> a -> Ordering
myCompare' a b
    | a > b = GT
    | a == b = EQ
    | otherwise = LT

where

initials :: String -> String -> String
initials firstname lastname = [f] ++ ". " ++ [l] ++ "."
    where
        (f:_) = firstname
        (l:_) = lastname

calcBmis :: (RealFloat a) => [(a, a)] -> [a]
calcBmis xs = [bmi w h | (w, h) <- xs]
    where bmi weight height = weight / height ^ 2

作用域

只对本函数（模式）可见

let

let [bindings] in [expressions]

Prelude> 4 * (let a = 9 in a + 1) + 2
42
Prelude> [let square x = x * x in (square 5, square 3, square 2)]
[(25,9,4)]
Prelude> let a = 1; b = 2; c = 3 in a * b * c
6
Prelude> let (a,b,c)=(1,2,3) in a*b*c
6

最后一个例子是模式匹配

列表推导

calcBmis :: (RealFloat a) => [(a, a)] -> [a]
calcBmis xs = [bmi | (w, h) <- xs, let bmi = w / h ^ 2, bmi >= 25.0]

交互模式

Prelude> let a = 1
Prelude> a
1
Prelude> let f = map (*) [0..]
Prelude> (f !! 4) 5
20
Prelude> let boot x y = x * y in boot 3 4
12
Prelude> boot

<interactive>:4:1: error: Variable not in scope: boot

case

case expression of pattern -> result
                   pattern -> result
                   pattern -> result
                   ...

模式匹配是 case 表达式的语法糖

describeList :: [a] -> String
describeList xs = "The list is " ++ case xs of
    [] -> "empty."
    [x] -> "a singleton list."
    xs -> "a longer list."

describeList' :: [a] -> String
describeList' xs = "The list is " ++ what xs
    where
        what [] = "empty."
        what [x] = "a singleton list."
        what xs = "a longer list."

高阶函数

Curried functions

只用箭头来分隔参数和返回值类型（左侧为参数，右侧为返回类型）

multThree :: (Num a) => a -> a -> a -> a
multThree x y z = x * y * z

multThree' :: (Num a) => a -> (a -> (a -> a))
multThree' x y z = x * y * z

部分应用（截断）

compareWithHundred :: (Num a, Ord a) => a -> Ordering
compareWithHundred x = compare 100 x

compareWithHundred' :: (Num a, Ord a) => a -> Ordering
compareWithHundred' = compare 100

divideByTen :: (Floating a) => a -> a
divideByTen = (/10)

isUpperAlphanum :: Char -> Bool
isUpperAlphanum = (`elem` ['A'..'Z'])

lambda

在 lambda 中使用模式匹配

Prelude> map (\(a,b) -> a + b) [(1,2),(3,5),(6,3),(2,6),(2,5)]
[3,8,9,8,7]

另一个例子

addThree :: (Num a) => a -> a -> a -> a
addThree x y z = x + y + z

addThree' :: (Num a) => a -> a -> a -> a
addThree' = \x -> \y -> \z -> x + y + z

zipWith

zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' _ [] _ = []
zipWith' _ _ [] = []
zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys

测试

*Main> zipWith' (zipWith' (*)) [[1,2,3],[3,5,6],[2,3,4]] [[3,2,2],[3,4,5],[5,4,3]]
[[3,4,6],[9,20,30],[10,12,12]]

flip

flip' :: (a -> b -> c) -> (b -> a -> c)
flip' f = g
    where g x y = f y x

flip'' :: (a -> b -> c) -> b -> a -> c
flip'' f y x = f x y

使用 lambda

flip''' :: (a -> b -> c) -> b -> a -> c
flip''' f = \x y -> f y x

map and filter

map

map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs

filter

filter :: (a -> Bool) -> [a] -> [a]
filter _ [] = []
filter p (x:xs)
    | p x = x : filter p xs
    | otherwise = filter p xs

fold and scan

fold

左折叠

reverse' :: [a] -> [a]
reverse' = foldl (\acc x -> x : acc) []

可以简化为

reverse' :: [a] -> [a]
reverse' = foldl (flip (:)) []

需要生成新列表时，倾向于使用右折叠（注意右折叠二元函数的参数顺序）

map' :: (a -> b) -> [a] -> [b]
map' f xs = foldr (\x acc -> f x : acc) [] xs

map'' :: (a -> b) -> [a] -> [b]
map'' f xs = foldl (\acc x -> acc ++ [f x]) [] xs

无限列表的折叠

右折叠可以处理无限列表，左折叠无法处理（利用 Haskell 的惰性）

原因：

foldr f init [1,2,3] 等价于执行 f 1 (f 2 (f 3 init))

foldl f init [1,2,3] 等价于执行 f (f (f init 1) 2) 3

andlist :: [Bool] -> Bool
andlist xs = foldr and' True xs

and' :: Bool -> Bool -> Bool
and' True x = x
and' False _ = False

测试

*Main> andlist (repeat False)
False

scan

Prelude> scanl (+) 0 [3,5,2,1]
[0,3,8,10,11]
Prelude> scanr (+) 0 [3,5,2,1]
[11,8,3,1,0]

函数应用

定义

($) :: (a -> b) -> a -> b
f $ x = f x

普通的函数调用符有最高的优先级，而 $ 的优先级则最低。用空格的函数调用符是左结合的，如 f a b c 与 ((f a) b) c 等价，而 $ 则是右结合的。

Prelude> (+3) 3 * 3
18
Prelude> (+3) $ 3 * 3
12

减少括号

Prelude> sum (filter (> 10) (map (*2) [2..10]))
80
Prelude> sum $ filter (> 10) $ map (*2) [2..10]
80

映射一个函数应用到一组函数组成的列表

Prelude> map ($ 3) [(4+),(10*),(^2),sqrt]
[7.0,30.0,9.0,1.7320508075688772]

此处 ($ 3) 取一个函数作为参数，然后将该函数应用到 3 上

函数组合

定义

(.) :: (b -> c) -> (a -> b) -> a -> c
f . g = \x -> f (g x)

单参数

Prelude> map (\xs -> negate (sum (tail xs))) [[1..5],[3..6],[1..7]]
[-14,-15,-27]
Prelude> map (negate . sum . tail) [[1..5],[3..6],[1..7]]
[-14,-15,-27]

多参数

部分应用

Prelude> sum (replicate 5 (max 6.7 8.9))
44.5
Prelude> (sum . replicate 5) (max 6.7 8.9)
44.5
Prelude> sum . replicate 5 $ max 6.7 8.9
44.5
Prelude> sum . replicate 5 . max 6.7 $ 8.9
44.5

Prelude> replicate 2 (product (map (*3) (zipWith max [1,2,3,4,5] [4,5,6,7,8])))
[1632960,1632960]
Prelude> replicate 2 . product . map (*3) $ zipWith max [1,2,3,4,5] [4,5,6,7,8]
[1632960,1632960]
Prelude> replicate 2 . product . map (*3) . zipWith max [1,2,3,4,5] $ [4,5,6,7,8]
[1632960,1632960]

Point-free Style

无参数

fn x = ceiling (negate (tan (cos (max 50 x))))

fn = ceiling . negate . tan . cos . max 50

左 . 右 $

sum (takeWhile (<10000) (filter odd (map (^2) [1..])))

sum . takeWhile (<10000) . filter odd . map (^2) $ [1..]

sum . takeWhile (<10000) . filter odd $ map (^2) [1..]

sum . takeWhile (<10000) $ filter odd $ map (^2) [1..]

sum $ takeWhile (<10000) $ filter odd $ map (^2) [1..]

模块

在交互模式中导入

Prelude> :m Data.List Data.Map Data.Set
Prelude Data.List Data.Map Data.Set> :t Data.Map.fromList
Data.Map.fromList :: Ord k => [(k, a)] -> Map k a
Prelude Data.List Data.Map Data.Set> :m - Data.Set
Prelude Data.List Data.Map>

GHC 7.0 之后，支持在 GHCi 环境直接使用 import 语法

Prelude> import qualified Data.Map as M
Prelude M>

在脚本中导入

import Data.List
import Data.List (nub, sort)
import Data.List hiding (nub)
import qualified Data.Map
import qualified Data.Map as M

qualified，限定导入，处理命名冲突

示例

import Data.Map

测试

*Main> :t filter

<interactive>:1:1: error:
    Ambiguous occurrence 'filter'
    It could refer to
       either 'Prelude.filter' ,
              imported from 'Prelude' at Main.hs:1:1
              (and originally defined in 'GHC.List')
           or 'Data.Map.filter' ,
              imported from 'Data.Map' at Main.hs:1:1-15
              (and originally defined in 'Data.Map.Internal')

若使用限定导入

import qualified Data.Map as M

测试

*Main> :t filter
filter :: (a -> Bool) -> [a] -> [a]
*Main> :t M.filter
M.filter :: (a -> Bool) -> M.Map k a -> M.Map k a

构造自己的模块

模块首字母必须大写

module Helper
(
    quicksort
) where

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
    let smallerSorted = quicksort [a | a <- xs, a <= x]
        biggerSorted = quicksort [a | a <- xs, a > x]
    in smallerSorted ++ [x] ++ biggerSorted

// Main.hs
import Helper

测试

Prelude> :l Main.hs
[1 of 2] Compiling Helper           ( Helper.hs, interpreted )
[2 of 2] Compiling Main             ( Main.hs, interpreted )
Ok, two modules loaded.
*Main> quicksort [1,4,3,2]
[1,2,3,4]

模块的层次结构

module Geometry.Sphere
(
    volume, area
) where

volume :: Float -> Float
volume radius = (4.0 / 3.0) * pi * (radius ^ 3)

area :: Float -> Float
area radius = 4 * pi * (radius ^ 2)

// Main.hs
import Geometry.Sphere

测试

*Main> :l Main.hs
[1 of 2] Compiling Geometry.Sphere  ( Geometry\Sphere.hs, interpreted )
[2 of 2] Compiling Main             ( Main.hs, interpreted )
Ok, two modules loaded.
*Main> area 4
201.06194

使用标准库中的模块

Data.List

惰性实现的严格版本

在用 fold 处理较大的 List 时，经常会遇到堆栈溢出的问题

Prelude> foldl (+) 0 (replicate 10000000000 1)
<interactive>: getMBlocks: VirtualAlloc MEM_COMMIT failed:

非严格版本的计算过程

foldl (+) 0 [1,2] =
foldl (+) (0 + 1) [2] =
foldl (+) ((0 + 1) + 2) [] =
(0 + 1) + 2 =
1 + 2 =
3

严格版本的计算过程

foldl' (+) 0 [1,2] = foldl' (+) (1) [2] = foldl' (+) (3) [] = 3

Data.Char

Prelude> :m Data.Char
Prelude Data.Char> ord 'a'
97
Prelude Data.Char> chr 97
'a'
Prelude Data.Char> digitToInt '2'
2
Prelude Data.Char> intToDigit 15
'f'

Data.Map

关联列表

findKey 实现了 Data.Map 中的 lookup

phoneBook =
    [("betty","555-2938"),
    ("bonnie","452-2928"),
    ("patsy","493-2928"),
    ("lucille","205-2928"),
    ("wendy","939-8282"),
    ("penny","853-2492")]

findKey :: (Eq k) => k -> [(k,v)] -> Maybe v
findKey key = foldr (\(k,v) acc -> if key == k then Just v else acc) Nothing

测试

*Main> findKey "betty" phoneBook
Just "555-2938"
*Main> findKey "wilma" phoneBook
Nothing

映射

fromList 将一个关联列表转换为与之等价的映射

Prelude Data.Map> Data.Map.fromList [(1,2),(3,4),(3,2),(5,5)]
fromList [(1,2),(3,2),(5,5)]
Prelude Data.Map> :t Data.Map.fromList
Data.Map.fromList :: Ord k => [(k, a)] -> Map k a

Prelude Data.Map> let map = Data.Map.fromList [(1,2),(3,4),(3,2),(5,5)]
Prelude Data.Map> Data.Map.lookup 3 map
Just 2
Prelude Data.Map> :t Data.Map.lookup
Data.Map.lookup :: Ord k => k -> Map k a -> Maybe a

Prelude Data.Map> Data.Map.fromListWith min [(1,2),(3,4),(3,2),(5,5)]
fromList [(1,2),(3,2),(5,5)]
Prelude Data.Map> :t Data.Map.fromListWith
Data.Map.fromListWith
  :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a

Data.Set

略

I/O

Haskell 实际上设计了一个非常聪明的系统来处理有副作用的函数，它漂亮地将我们的程序区分成纯粹和非纯粹部分。非纯粹的部分负责和键盘还有屏幕沟通。有了这区分的机制，在和外界沟通的同时，我们还是能够有效运用纯粹所带来的好处，像是惰性求值、容错性和模组性。

I/O action

基础

main = putStrLn "hello, world"

编译并运行

PS C:\Users\VGalaxy> stack ghc Main.hs
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking Main.exe ...
PS C:\Users\VGalaxy> ./Main
hello, world

一个 I/O action 会在我们把它绑定到 main 这个名字并且执行程序的时候触发

Prelude> :t putStrLn
putStrLn :: String -> IO ()
Prelude> :t putStrLn "hello"
putStrLn "hello" :: IO ()

组合

do blocks

main = do
    putStrLn "Hello, what's your name?"
    name <- getLine
    putStrLn ("Hey " ++ name ++ ", you rock!")

我们写了一个 do 并且接着一连串指令，每一步都是一个 I/O action。将所有 I/O action 用 do 绑在一起变成了一个大的 I/O action。这个大的 I/O action 的类型是 IO ()，这完全是由最后一个 I/O action 所决定的。

名字绑定

Prelude> :t getLinegetLine :: IO String

getLine 是一个返回 String 的 I/O action，name <- getLine 执行一个 I/O action 并将它的结果绑定到 name 这个名字。

getLine 在这样的意义下是不纯粹的，因为执行两次的时候它没办法保证会返回一样的值。需要注意的是，只能在不纯粹的环境（I/O action）中处理不纯粹的数据（name <- getLine）。

每个 I/O action 都有一个值封装在里面。这也是为什么之前的程序可以这么写：

main = do
    foo <- putStrLn "Hello, what's your name?"
    name <- getLine
    putStrLn ("Hey " ++ name ++ ", you rock!")

foo 只会有一个 () 的值。另外，最后一个 action 不能绑定任何名字。

可以在 do blocks 中使用 let bindings（为纯粹的值绑定名字），与 list comprehensions 中的使用类似：

import Data.Char

main = do
    putStrLn "What's your first name?"
    firstName <- getLine
    putStrLn "What's your last name?"
    lastName <- getLine
    let bigFirstName = map toUpper firstName
        bigLastName = map toUpper lastName
    putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?"

而 let firstName = getLine 只不过是把 getLine 这个 I/O action 起了一个不同的名字罢了。

总结：

绑定 I/O action 的结果时用 <-
对于纯粹的 expression 使用 let bindings

分支与递归

main = do
    line <- getLine
    if null line
        then return ()
        else (do
            putStrLn $ reverseWords line
            main)

reverseWords :: String -> String
reverseWords = unwords . map reverse . words

if condition then I/O action else I/O action

return

在 Haskell 中，return 的意义是利用某个 pure value 构建返回某值的 I/O action

return 不会中断 do blocks 的执行

main = do
    return ()
    return "HAHAHA"
    line <- getLine
    return "BLAH BLAH BLAH"
    return 4
    putStrLn line

配合 <- 与 return 来绑定名字：

main = do
    a <- return "hell"
    b <- return "yeah!"
    putStrLn $ a ++ " " ++ b

可以发现，可以看到 <- 与 return 作用相反。之前的程序也可以这么写：

main = do
    let a = "hell"
        b = "yeah"
    putStrLn $ a ++ " " ++ b

交互模式

在交互模式中输入一个 I/O action 并按下 Enter 键，I/O action 也会被执行：

Prelude> putStrLn "HEEY"
HEEY

I/O functions

putStr and putChar

putStr 相当于不换行的 putStrLn

Prelude> :t putChar
putChar :: Char -> IO ()
Prelude> :t putStr
putStr :: String -> IO ()

putStr 实际上就是 putChar 递归定义出来的

putStr :: String -> IO ()
putStr [] = return ()
putStr (x:xs) = do
    putChar x
    putStr xs

getChar

注意缓冲区，只有当 Enter 被按下的时候才会触发读取字符的行为

main = do
    c <- getChar
    if c /= ' '
        then do
            putChar c
            main
        else return ()

编译并运行

$ ./Main
hello sir
hello

print

print 相当于 putStrLn . show

Prelude> :t print
print :: Show a => a -> IO ()

在交互模式中，在终端显示结果利用的就是 print

Prelude> 3
3
Prelude> print 3
3
Prelude> map (++"!") ["hey","ho","woo"]
["hey!","ho!","woo!"]
Prelude> print (map (++"!") ["hey", "ho", "woo"])
["hey!","ho!","woo!"]

print 和 putStrLn 的一点小区别

Prelude> print "a"
"a"
Prelude> putStrLn "a"
a

when

将 if something then do some I/O action else return () 这样的模式封装起来

import Control.Monad

main = do
    c <- getChar
    when (c /= ' ') $ do
        putChar c
        main

sequence

sequence :: [IO a] -> IO [a]

Prelude> :t sequence
sequence :: (Traversable t, Monad m) => t (m a) -> m (t a)

示例

main = do
    a <- getLine
    b <- getLine
    c <- getLine
    print [a,b,c]

等同于

main = do
    rs <- sequence [getLine, getLine, getLine]
    print rs

另一个示例

Prelude> sequence (map print [1,2,3,4,5])
1
2
3
4
5
[(),(),(),(),()]

解释 [(),(),(),(),()]：在交互模式中对 I/O action 求值，它会被执行，并将结果返回，除非结果是 ()

mapM and mapM_

Prelude> mapM print [1,2,3]
1
2
3
[(),(),()]
Prelude> mapM_ print [1,2,3]
1
2
3

forever

forever 接受一个 I/O action 并返回一个永远执行该 I/O action 的 I/O action

import Control.Monad
import Data.Char

main = forever $ do
    l <- getLine
    putStrLn $ map toUpper l

forM

forM 和 mapM 的作用一样，只是参数的顺序相反而已

import Control.Monad

main = do
    colors <- forM [1,2,3,4] (\a -> do
        putStrLn $ "Which color do you associate with the number " ++ show a ++ "?"
        color <- getLine
        return color)
    putStrLn "The colors that you associate with 1, 2, 3 and 4 are: "
    mapM putStrLn colors

这里的 (\a -> do ...) 是接受一个数字并返回一个 I/O action 的函数

文件和流

输入重定向

在 Linux 环境中测试

import Control.Monad
import Data.Char

main = forever $ do
    l <- getLine
    putStrLn $ map toUpper l

// haiku.txt
I'm a lil' teapot
What's with that airplane food, huh?
It's so small, tasteless

测试

vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$ ./Main < haiku.txt
I'M A LIL' TEAPOT
WHAT'S WITH THAT AIRPLANE FOOD, HUH?
IT'S SO SMALL, TASTELESS
Main: <stdin>: hGetLine: end of file
vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$

从输入流获取字符串

使用 getContents 重写上述程序，getContents 从标准输入里读取所有的东西直到遇到 EOF

getContents 类型签名为 getContents :: IO String

getContents 使用 Lazy I/O（似乎表现为按行处理）

import Data.Char

main = do
    contents <- getContents
    putStr (map toUpper contents)

重定向测试

vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$ ./Main < haiku.txt
I'M A LIL' TEAPOT
WHAT'S WITH THAT AIRPLANE FOOD, HUH?
IT'S SO SMALL, TASTELESSvgalaxy
@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$

直接输入测试

vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$ ./Main
this
THIS
is
IS
great
GREAT
vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$

转换输入

使用 interact 重写上述程序，interact 取一个类型为 String->String 的函数作为参数，返回一个 I/O action

interact 类型签名为 interact :: (String -> String) -> IO ()

import Data.Char

main = interact (map toUpper)

文件读写

openFile

openFile :: FilePath -> IOMode -> IO Handle

注解：

type FilePath = String
data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode

示例

import System.IO

main = do
    handle <- openFile "haiku.txt" ReadMode
    contents <- hGetContents handle
    putStr contents
    hClose handle

hGetContents 接受一个文件句柄作为参数，其类型签名为 hGetContents :: Handle -> IO String，类似 getContents

hClose 接受一个文件句柄作为参数，其类型签名为 hClose :: Handle -> IO ()

注：就像 hGetContents 对应 getContents 一样，只不过是针对某个文件。我们也有 hGetLine、hPutStr、hPutStrLn、hGetChar 等等。他们分别是少了 h 的那些函数的对应。只不过他们要多拿一个 handle 当参数，并且是针对特定文件而不是标准输出或标准输入。

withFile

withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r

withFile 会确保文件句柄被关闭

使用 withFile 重写上述程序

import System.IO

main = do
    withFile "haiku.txt" ReadMode (\handle -> do
        contents <- hGetContents handle
        putStr contents)

我们考虑实现 withFile，使用 bracket，其类型签名为：

bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c

第一个参数为一个请求资源的 I/O action
第二个参数为一个释放资源的函数，无论是否出现异常
第三个参数是主要部分，如读写文件

import Control.Exception
import System.IO

withFile' :: FilePath -> IOMode -> (Handle -> IO a) -> IO a
withFile' path mode f = bracket (openFile path mode)
    (\handle -> hClose handle)
    (\handle -> f handle)

main = do
    withFile' "haiku.txt" ReadMode (\handle -> do
        contents <- hGetContents handle
        putStr contents)

readFile

readFile :: FilePath -> IO String

使用 readFile 重写上述程序

import System.IO

main = do
    contents <- readFile "haiku.txt"
    putStr contents

注意，此处我们没有得到文件句柄，readFile 的内部实现帮助我们关闭了文件句柄

writeFile and appendFile

writeFile :: FilePath -> String -> IO ()

import System.IO
import Data.Char

main = do
    contents <- readFile "haiku.txt"
    writeFile "new.txt" (map toUpper contents)

如果我们尝试如下操作，会报错 Main: haiku.txt: openFile: resource busy (file is locked)

import System.IO
import Data.Char

main = do
    contents <- readFile "haiku.txt"
    writeFile "haiku.txt" (map toUpper contents)

我们需要一个临时文件来传递数据，为此使用函数 openTempFile，其类型签名为：

openTempFile :: FilePath -> String -> IO (FilePath, Handle)

import System.IO
import System.Directory
import Data.Char

main = do
    contents <- readFile "haiku.txt"
    (tempName, tempHandle) <- openTempFile "." "temp"
    hPutStr tempHandle (map toUpper contents)
    hClose tempHandle
    removeFile "haiku.txt"
    renameFile tempName "haiku.txt"

其中还使用了 System.Directory 中的：

removeFile :: FilePath -> IO ()
renameFile :: FilePath -> FilePath -> IO ()

为了确保在发生异常时临时文件能够被清理掉，我们将使用 bracketOnError，其类型签名为：

bracketOnError :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c

类似 bracket，只不过 bracketOnError 当出现异常时才会释放资源，重写上述程序

import System.IO
import System.Directory
import Data.Char
import Control.Exception


main = do
    contents <- readFile "haiku.txt"
    bracketOnError (openTempFile "." "temp")
        (\(tempName, tempHandle) -> do
            hClose tempHandle
            removeFile tempName)
        (\(tempName, tempHandle) -> do
            hPutStr tempHandle (map toUpper contents)
            hClose tempHandle
            removeFile "haiku.txt"
            renameFile tempName "haiku.txt")

命令行参数

import System.Environment
import Data.List

main = do
    args <- getArgs
    progName <- getProgName
    putStrLn "The arguments are:"
    mapM putStrLn args
    putStrLn "The program name is:"
    putStrLn progName

测试

vgalaxy@LAPTOP-3GATQU5H:/mnt/c/Users/VGalaxy/code$ ./Main 1st 2nd
The arguments are:
1st
2nd
The program name is:
Main

这里用到了 getArgs 和 getProgName，其类型签名分别为：

getArgs :: IO [String]
getProgName :: IO String

随机性：Random

需要先安装 PS C:\Users\VGalaxy> stack install random

random

random :: (Random a, RandomGen g) => g -> (a, g)

接受一个随机性生成器，返回一个随机值和一个新的随机性生成器

为了使用 random，System.Random 导出了一个类型叫做 StdGen，通过 :info 查看其信息

data StdGen
  = System.Random.StdGen {-# UNPACK #-}GHC.Int.Int32
                         {-# UNPACK #-}GHC.Int.Int32
        -- Defined in 'System.Random'
instance Show StdGen -- Defined in 'System.Random'
instance RandomGen StdGen -- Defined in 'System.Random'
instance Read StdGen -- Defined in 'System.Random'

可知 StdGen 为 RandomGen 类型类的一个实例

为了得到一个 StdGen 的随机性生成器，我们使用 mkStdGen 函数

mkStdGen :: Int -> StdGen

来试一试，第一次使用会有一些提示信息（下面的示例会去掉提示信息）

Prelude System.Random> random (mkStdGen 100)
ghc.exe: addLibrarySearchPath: C:\Users\VGalaxy\AppData\Local\Programs\stack\x86_64-windows\msys2-20180531\mingw64\lib (Win32 error 3):
ghc.exe: addLibrarySearchPath: C:\Users\VGalaxy\AppData\Local\Programs\stack\x86_64-windows\msys2-20180531\mingw64\bin (Win32 error 3):
(-3633736515773289454,693699796 2103410263)

参数相同，返回的随机值也相同

Prelude System.Random> random (mkStdGen 100)
(-3633736515773289454,693699796 2103410263)

我们换一个参数

Prelude System.Random> random (mkStdGen 1000)
(1611434616111168504,1261958764 2103410263)

也可以使用类型注解

Prelude System.Random> random (mkStdGen 1000) :: (Bool, StdGen)
(True,40054014 40692)

我们来写一个掷硬币的小程序

import System.Random

threeCoins :: StdGen -> (Bool, Bool, Bool)
threeCoins gen =
    let (firstCoin, newGen) = random gen
        (secondCoin, newGen') = random newGen
        (thirdCoin, newGen'') = random newGen'
    in (firstCoin, secondCoin, thirdCoin)

测试，注意这次是装载脚本，而非编译程序

*Main> threeCoins (mkStdGen 21)
(True,True,True)
*Main> threeCoins (mkStdGen 22)
(True,False,True)

randoms

randoms :: (Random a, RandomGen g) => g -> [a]

返回一个无限长的随机值序列，因为无限长，所以无法返回最后得到的新随机性生成器

在交互界面试一试

Prelude System.Random> take 5 $ (randoms (mkStdGen 11))
[5260538044923710387,4361398698747678847,-8221315287270277529,7278185606566790575,1652507602255180489]

我们可以写一个函数，返回一个有限长的随机值序列和一个新随机性生成器，注意此处 Eq n 的类型约束

import System.Random

finiteRandoms :: (RandomGen g, Random a, Num n, Eq n) => n -> g -> ([a], g)
finiteRandoms 0 gen = ([], gen)
finiteRandoms n gen =
    let (value, newGen) = random gen
        (restOfList, finalGen) = finiteRandoms (n-1) newGen
    in (value:restOfList, finalGen)

装载脚本来试一试（似乎装载脚本前导入模块就不会有提示信息了）

*Main System.Random> finiteRandoms 5 (mkStdGen 100)
([-3633736515773289454,-1610541887407225575,4434840125058622350,1116419036860971948,1434273519690261584],1772499918 2118231989)

randomR and randomRs

randomR :: (Random a, RandomGen g) => (a, a) -> g -> (a, g)

第一次参数是一个下界和上界的序对

Prelude System.Random> randomR (1,6) (mkStdGen 12345)
(6,494012844 40692)
Prelude System.Random> randomR (1,6) (mkStdGen 123456)
(4,645041272 40692)
Prelude System.Random> randomR (1,6) (mkStdGen 1234567)
(1,7882003 40692)

randomRs :: (Random a, RandomGen g) => (a, a) -> g -> [a]

类似 randomR，返回一个有界的随机值序列

Prelude System.Random> take 10 $ randomRs ('a','z') (mkStdGen 3)
"xnuhlfwywq"

随机性与 I/O

getStdGen :: IO StdGen，向系统索要初始数据，来启动全局生成器

newStdGen :: IO StdGen，更新全局生成器

写一段程序，让用户猜测它想的数是什么

第一种方法，使用 randomR 返回的新随机性生成器显式改变参数，注意两处 prompt，处理 Lazy I/O

import System.Random
import Control.Monad(when)

main = do
    gen <- getStdGen
    prompt
    askForNumber gen

prompt = putStrLn "Which number in the range from 1 to 10 am I thinking of? "

askForNumber :: StdGen -> IO ()
askForNumber gen = do
    let (randNumber, newGen) = randomR (1,10) gen :: (Int, StdGen)
    numberString <- getLine
    when (not $ null numberString) $ do
        let number = read numberString
        if randNumber == number
            then putStrLn "You are correct!"
            else putStrLn $ "Sorry, it was " ++ show randNumber
        prompt
        askForNumber newGen

第二种方法，通过 newStdGen 更新全局生成器

import System.Random
import Control.Monad(when)

prompt = putStrLn "Which number in the range from 1 to 10 am I thinking of? "

main = do
    prompt
    gen <- getStdGen
    let (randNumber, _) = randomR (1,10) gen :: (Int, StdGen)
    numberString <- getLine
    when (not $ null numberString) $ do
        let number = read numberString
        if randNumber == number
            then putStrLn "You are correct!"
            else putStrLn $ "Sorry, it was " ++ show randNumber
        newStdGen
        main

再谈惰性：ByteString

目前为止，我们都是用字符串处理文件，而字符串不过是列表的语法糖，注意列表的是惰性的，所以并不高效。

关于惰性的进一步解释，可以参阅 Thunk - HaskellWiki

ByteString 很像列表，每个元素占一个字节，它们处理惰性的方法也不一样。

ByteString 有两种风格，严格的和惰性的：

严格的：完全废除了惰性，不能有无限长的严格的 ByteString，对一个严格的 ByteString 的第一个字节求值，就必须对整个 ByteString 求值
惰性的：惰性程度不如列表，可以视其为严格的 ByteString 的列表，它会按块 (chunk) 读取，每个块大小为 64 KB，对一个惰性的 ByteString 的第一个字节求值，就会对最开头的块求值

导入 ByteString 时必须使用限定导入

import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as S

一些类似的函数

Prelude B S> :t B.map
B.map
  :: (GHC.Word.Word8 -> GHC.Word.Word8)
     -> B.ByteString -> B.ByteString
Prelude B S> :t S.map
S.map
  :: (GHC.Word.Word8 -> GHC.Word.Word8)
     -> S.ByteString -> S.ByteString
Prelude B S> :t B.readFile
B.readFile :: FilePath -> IO B.ByteString
Prelude B S> :t S.readFile
S.readFile :: FilePath -> IO S.ByteString

pack and unpack

先看类型签名

Prelude B S> :t B.pack
B.pack :: [GHC.Word.Word8] -> B.ByteString
Prelude B S> :t S.pack
S.pack :: [GHC.Word.Word8] -> S.ByteString
Prelude B S> :t B.unpack
B.unpack :: B.ByteString -> [GHC.Word.Word8]
Prelude B S> :t S.unpack
S.unpack :: S.ByteString -> [GHC.Word.Word8]

将列表转换为 ByteString，其中的 Word8 表示无符号的 8 位整数，如果越界，会有警告

Prelude B S> B.pack [99..120]
"cdefghijklmnopqrstuvwx"
Prelude B S> B.pack [80,336]

<interactive>:9:12: warning: [-Woverflowed-literals]
    Literal 336 is out of the GHC.Word.Word8 range 0..255
"PP"

将 ByteString 转换为列表

Prelude B S> let by = B.pack [99..120]
Prelude B S> B.unpack by
[99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120]

B.fromChunks and B.toChunks

先看类型签名

Prelude B S> :t B.fromChunks
B.fromChunks :: [S.ByteString] -> B.ByteString
Prelude B S> :t B.toChunks
B.toChunks :: B.ByteString -> [S.ByteString]

严格的 ByteString 列表与惰性的 ByteString 之间互相转换

Prelude B S> let by = B.fromChunks [S.pack [40..50], S.pack[50..60]]
Prelude B S> by
"()*+,-./01223456789:;<"
Prelude B S> B.toChunks by
["()*+,-./012","23456789:;<"]

cons

类似 :

Prelude B S> :t B.cons
B.cons :: GHC.Word.Word8 -> B.ByteString -> B.ByteString
Prelude B S> :t S.cons
S.cons :: GHC.Word.Word8 -> S.ByteString -> S.ByteString

接受一个字节和一个 ByteString

Prelude B S> B.cons 85 $ B.pack [80..84]
"UPQRST"
Prelude B S> S.cons 85 $ S.pack [80..84]
"UPQRST"

用 ByteString 复制文件

所有的 I/O functions 都为 ByteString 版本，其余部分没有区别

这里使用了命令行参数

import System.IO
import System.Directory
import System.Environment
import Data.Char
import Control.Exception
import qualified Data.ByteString.Lazy as B


main = do
    (src:dst:_) <- getArgs
    copy src dst

copy src dst = do
    contents <- B.readFile src
    bracketOnError (openTempFile "." "temp")
        (\(tempName, tempHandle) -> do
            hClose tempHandle
            removeFile tempName)
        (\(tempName, tempHandle) -> do
            B.hPutStr tempHandle contents
            hClose tempHandle
            renameFile tempName dst)

Haskell 趣学指南 第一部分

TOC

环境配置

相关资源

基础

进入交互模式

装载脚本

编译程序

执行程序

列表和元组

列表

拼接

构建

索引

区间

列表推导

元组

函数

函数调用

条件分支

模式匹配

元组的模式匹配

列表的模式匹配

as-pattern

guard

where

作用域

let

列表推导

交互模式

case

高阶函数

Curried functions

lambda

zipWith

flip

map and filter

fold and scan

fold

scan

函数应用

定义

减少括号

映射一个函数应用到一组函数组成的列表

函数组合

定义

单参数

多参数

Point-free Style

模块

在交互模式中导入

在脚本中导入

构造自己的模块

模块的层次结构

使用标准库中的模块

Data.List

惰性实现的严格版本

Data.Char

Data.Map

关联列表

映射

Data.Set

I/O

I/O action

基础

组合

名字绑定

分支与递归

return

交互模式

I/O functions

putStr and putChar

getChar

print

when

sequence

mapM and mapM_

forever

forM

文件和流

Haskell 趣学指南第一部分