1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# LANGUAGE GADTs #-}
module Query where
import Control.Selective
import Data.List (isInfixOf, stripPrefix)
type Prompt = String
data Query a where
Terminal :: Prompt -> Query String
File :: FilePath -> Query String
Pure :: a -> Query a
Apply :: Query (a -> b) -> Query a -> Query b
Select :: Query (Either a b) -> Query (a -> b) -> Query b
instance Functor Query where
fmap f = Apply (Pure f)
instance Applicative Query where
pure = Pure
(<*>) = Apply
instance Selective Query where
select = Select
pureQuery :: Query String
pureQuery = (++) <$> Pure "Hello " <*> Pure "World!"
replace :: String -> String -> String -> String
replace [] _ xs = xs
replace from to xs | Just xs <- stripPrefix from xs = to ++ replace from to xs
replace from to (x:xs) = x : replace from to xs
replace _ _ [] = []
welcomeQuery :: Query String
welcomeQuery = replace "[NAME]" <$> Terminal "Name" <*> File "welcome.txt"
welcomeBackQuery :: Query String
welcomeBackQuery = (++) <$> welcomeQuery <*> pure "It's great to have you back!\n"
welcomeQuery2 :: Query String
welcomeQuery2 =
ifS (isInfixOf <$> Terminal "Name" <*> File "past-participants.txt")
welcomeBackQuery
welcomeQuery
getPure :: Query a -> Maybe a
getPure (Terminal _) = Nothing
getPure (File _) = Nothing
getPure (Pure a) = Just a
getPure (Apply f x) = do
pf <- getPure f
px <- getPure x
pure (pf px)
getPure (Select x y) = do
px <- getPure x
py <- getPure y
pure (either py id px)
getEffects :: Query a -> ([Prompt], [FilePath])
getEffects (Terminal p) = ([p], [] )
getEffects (File f) = ([] , [f])
getEffects (Pure _) = ([] , [] )
getEffects (Apply f x) = (p1 ++ p2, f1 ++ f2)
where
(p1, f1) = getEffects f
(p2, f2) = getEffects x
getEffects (Select x y) = (px ++ py, fx ++ fy)
where
(px, fx) = getEffects x
(py, fy) = getEffects y
|
