-- 一个经典的菲波纳契数列的函数定义,求每一个位置上的数值
fib 1 = 1
fib 2 = 1
fib n = fib(n-1) + fib(n-2)
-- 产生一个无限长的fib数列
fib_l n = fib n : fib_l(n+1)
take 10 (fib_l 1) => [1,1,2,3,5,8,13,21,34,55]
--另一个更快解法
fibs = fibgen 1 1
where fibgen n1 n2 = n1 : fibgen n2 (n1+n2)
--求解素数的一个无限数列方法:
prime = sieve [2..]
where sieve (x:xs) = x : sieve (filter (/y ->y `rem` x /= 0) xs)
take 25 prime => [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
--对可变(mutable)变量的读写
incRef :: IORef Int -> IO ( )
incRef var = do {
val <- readIORef var
writeIORef var (val+1)
}
--文件操作
readUtf8File :: FilePath -> IO String
readUtf8File filePath
= do h <- openFile filePath ReadMode
hSetEncoding h utf8
hSetEncoding stdout utf8
hGetContents h
betterStdGen :: IO StdGen
betterStdGen = alloca $ /p -> do
h <- openBinaryFile "/dev/urandom" ReadMode
hGetBuf h p $ sizeOf (undefined :: Int)
hClose h
mkStdGen <$> peek p
--模拟for循环的函数
nTimes :: Int -> IO () -> IO ()
nTimes 0 do_this = return ()
nTimes n do_this = do {
do_this;
nTimes (n-1) do_this;
}
main = nTimes 10 (hPutStr stdout "Hello") --重复输出10个"Hello"
-- for(i=0; i<100; i++) {}
for :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
for start test step body = loop start where
loop x = if test x
then body x >> loop (step x)
else return ()
main = for 0 (< 100) (+ 1) $ /i -> do
-- do something with i
print i
--例外处理
set_prefs = do
finally
(catch (appendFile ".darcs/defaults" "/nALL --ignore-times/n")
(/e -> fail $ "Unable to set preferences: " ++ show e))
(createDirectoryIfMissing False ".darcs")
catchIO :: MonadIO m => IO () -> m ()
catchIO f = liftIO (f `catch` /e -> hPrint stderr e >> hFlush stderr)
spawnPID :: MonadIO m => String -> m ProcessID
spawnPID x = liftIO . forkProcess . finally nullStdin $ do
uninstallSignalHandlers
createSession
executeFile "/bin/sh" False ["-c", x] Nothing
where
nullStdin = do
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
dupTo fd stdInput
closeFd fd
--如果值有空格就加上引号
> [k ++ "=" ++ c ++ v ++ c | (k,v) <- [("key1","123"),("key2","abc 456")] ,let c = ['/"' | any isSpace v]]
["key1=123","key2=/"abc 456/""]
--转义
escapeHTML = concatMap f
where
f '/"' = """
f '<' = "<"
f '>' = ">"
f '&' = "&"
f '/n' = "<br/>"
f x = [x]
escapeCGI = concatMap f
where
f x | isAlphaNum x || x `elem` "-" = [x]
| x == ' ' = "+"
| otherwise = '%' : ['0'|length s == 1] ++ s
where s = showHex (ord x) ""
--位操作
let w4 = (w32 `shiftR` 24) .&. 0xff
w3 = (w32 `shiftR` 16) .&. 0xff
w2 = (w32 `shiftR` 8) .&. 0xff
w1 = w32 .&. 0xff
return $! (w4 `shiftL` 24) .|.
(w3 `shiftL` 16) .|.
(w2 `shiftL` 8) .|.
(w1)
--数组操作
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed.Mutable as M
replicateM n action = do
mu <- M.unsafeNew n
let go !i | i < n = action >>= M.unsafeWrite mu i >> go (i+1)
| otherwise = G.unsafeFreeze mu
go 0
--网络编程
import System.IO
import Network
main = do
let a="λ"
s <- connectTo "127.0.0.1" (PortNumber 1234)
hSetEncoding s utf8
hSetEncoding stdout utf8
hPutStrLn s a
putStrLn a
hClose s
-- create a write-only socket
connectTo hostname (PortNumber port) = do
proto <- getProtocolNumber "tcp"
bracketOnError
(socket AF_INET Stream proto)
(sClose) -- only done if there's an error
(/sock -> do
he <- getHostByName hostname
connect sock (SockAddrInet port (hostAddress he))
socketToHandle sock WriteMode
)
--C/S例子
--使用状态{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVarimport Control.Monad (forever, liftM)import Network (listenOn, withSocketsDo, PortID(..))
import Network.BSD (getProtocolNumber)
import Network.Socket (Family(..), SockAddr(..), SocketType(..), Socket(..),
accept, connect, inet_addr, socket, sClose)import Network.Socket.ByteStringimport Data.ByteString.Char8 ()
import System.Environment (getArgs)
import System.IO (stdout, hFlush)
port = 8080
main = doargs <- getArgs
if length args < 1 || (head args /= "client" && head args /=
"server")then putStrLn "say client or server"
else withSocketsDo $ case head args of
"client" -> client
"server" -> serverclient = do
putStrLn "Client mode"
tcp <- getProtocolNumber "tcp"forever $ do sock <- socket AF_INET Stream tcp
localhost <- inet_addr "127.0.0.1"
putStr "Making a connection..."
connect sock (SockAddrInet port localhost)
send sock "a"
_ <- recv sock 1
sClose sock
putStrLn " done client connection"
server = do
putStrLn "Server mode"sock <- listenOn (PortNumber port)
count <- newMVar 0
forever $ do count' <- modifyMVar count (/c -> return (c+1,c+1))
putStr $ (show count') ++ " About to accept..."
(conn, _saddr) <- accept sock
putStrLn " accepted."
hFlush stdout
forkIO $ handleServerConnection conn count'
handleServerConnection conn count = doputStr $ (show count) ++ " Handling a server connection..."
rd <- recv conn 1
send conn "a"sClose conn
putStrLn " done server connection."hFlush stdout
import Control.Monad.State
import Test.QuickCheck
tThis = take 5 . show . mybreak (>4000000) $ [1..10^7]
tPrel = take 5 . show . prelbreak (>4000000) $ [1..10^7]
prelbreak p xs = (takeWhile (not . p) xs,dropWhile (not . p) xs) -- fast, more or less as implemented in prelude
mybreak p xs = evalState (brk p) ([],xs) -- stateful, slow
brk p = do
(notsat,remaining) <- get
case remaining of
[] -> return (notsat,remaining)
(r:rs) -> if p r
then return (notsat,remaining)
else do put (notsat++[r],rs)
brk p
From http://blogold.chinaunix.net/u3/104903/showart_2074180.html