Просмотр исходного кода

Restructure and document 'Hello, Monads!' a bit.

Lucas Stadler лет назад: 13
Родитель
Сommit
c001c1b86f
1 измененных файлов с 23 добавлено и 8 удалено
  1. 23 8
      hs/HelloMonads.hs

+ 23 - 8
hs/HelloMonads.hs

1
{-
2
 - Hello, Monads!
3
 -
4
 - Exploring what Monads mean (in Haskell).
5
 -}
1
import Prelude hiding (Maybe(..), print, putStr, putStrLn, getLine, getContent)
6
import Prelude hiding (Maybe(..), print, putStr, putStrLn, getLine, getContent)
2
7
3
-- define Maybe here so we can implement our own monad
8
-- define Maybe here so we can implement our own monad
24
29
25
type InputState = String
30
type InputState = String
26
type OutputState = String
31
type OutputState = String
32
-- * Model IO as a function of the previous state to a new state and a result.
33
--
34
-- If you look closely (i.e. execute `:i IO` in ghci), you'll notice
35
-- that this is a simplification of the real IO type.
36
-- Of course it is missing file handles, actual output and other
37
-- gimmicks, but it gives an idea of what IO does (and why).
27
data WeirdIO a = WeirdIO ((InputState, OutputState) -> ((InputState, OutputState), a))
38
data WeirdIO a = WeirdIO ((InputState, OutputState) -> ((InputState, OutputState), a))
28
39
29
executeWeirdIO :: InputState -> WeirdIO a -> ((InputState, OutputState), a)
40
executeWeirdIO :: InputState -> WeirdIO a -> ((InputState, OutputState), a)
37
48
38
    return x = WeirdIO $ \state -> (state, x)
49
    return x = WeirdIO $ \state -> (state, x)
39
50
40
takeUntil :: (a -> Bool) -> [a] -> [a]
41
takeUntil p [] = []
42
takeUntil p (x:xs) = if (p x) then [x] else x : takeUntil p xs
43
44
dropUntil p [] = []
45
dropUntil p (x:xs) = if (p x) then xs else dropUntil p xs
46
47
print x = WeirdIO $ \(i, o) -> ((i, o ++ show x ++ "\n"), ())
51
print :: Show a => a -> WeirdIO ()
52
print x = putStrLn $ show x
53
putStr, putStrLn :: String -> WeirdIO ()
48
putStr s = WeirdIO $ \(i, o) -> ((i, o ++ s), ())
54
putStr s = WeirdIO $ \(i, o) -> ((i, o ++ s), ())
49
putStrLn s = putStr $ s ++ "\n"
55
putStrLn s = putStr $ s ++ "\n"
50
56
57
getChar :: WeirdIO Char
51
getChar = WeirdIO $ \(c:cs, o) -> ((cs, o), c)
58
getChar = WeirdIO $ \(c:cs, o) -> ((cs, o), c)
59
getLine, getContent :: WeirdIO String
52
getLine = WeirdIO $ \(i, o) -> (((dropUntil (== '\n') i), o), takeWhile (/= '\n') i)
60
getLine = WeirdIO $ \(i, o) -> (((dropUntil (== '\n') i), o), takeWhile (/= '\n') i)
53
getContent = WeirdIO $ \(i, o) -> (("", o), i)
61
getContent = WeirdIO $ \(i, o) -> (("", o), i)
62
63
takeUntil :: (a -> Bool) -> [a] -> [a]
64
takeUntil p [] = []
65
takeUntil p (x:xs) = if (p x) then [x] else x : takeUntil p xs
66
67
dropUntil p [] = []
68
dropUntil p (x:xs) = if (p x) then xs else dropUntil p xs