/
bird.hs
65 lines (55 loc) · 1.82 KB
/
bird.hs
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
module Main where
import System.Process
import System.Environment (getArgs)
import Directory
main = do
args <- getArgs
runArg $ head args
runArg a =
case a of
"nest" -> readProcess "ghc" ["--make", "-O2", "Main.hs"] "" >> return ()
"fly" -> readProcess "./Main" [] "" >> return ()
appName -> createBirdApp appName
createBirdApp a = do
createDirectory a
writeFile (a ++ "/" ++ a ++ ".hs") (routeFile a)
writeFile (a ++ "/" ++ "Main.hs") (mainFile a)
routeFile a =
"module " ++ a ++ " where\n" ++
"import Data.Maybe\n" ++
"import Bird\n\n" ++
"get, post, put, delete :: Path -> BirdRouter ()\n" ++
"get [] = do\n" ++
" name <- param $ \"name\"\n" ++
" body $ \"Hello, \" ++ (maybe \"Bird!\" id name)\n\n" ++
"get _ = status 404\n" ++
"post _ = status 404\n" ++
"put _ = status 404\n" ++
"delete _ = status 404\n"
mainFile a =
"import Hack\n" ++
"import qualified Hack as Hack\n" ++
"import Hack.Handler.Happstack\n" ++
"import Bird\n" ++
"import qualified Bird as Bird\n" ++
"import Bird.Translator.Hack\n" ++
"import qualified Control.Monad.State as S\n" ++
"import qualified Control.Monad.Reader as R\n" ++
"import " ++ a ++ "\n" ++ "\n" ++
"app :: Application\n" ++
"app = \\e -> route e\n" ++ "\n" ++
"route :: Env -> IO Response\n" ++
"route e = response\n" ++
" where \n" ++
" req = toBirdRequest e\n" ++
" response = do \n" ++
" reply <- R.runReaderT (S.execStateT (matchRequest req) def) req\n" ++
" return $ fromBirdReply reply\n" ++ "\n" ++
"matchRequest r = \n" ++
" case verb r of \n" ++
" Bird.GET -> get $ path r\n" ++
" Bird.POST -> post $ path r\n" ++
" Bird.PUT -> put $ path r\n" ++
" Bird.DELETE -> delete $ path r\n" ++
" _ -> error \"not supported\"\n" ++ "\n" ++
"main = run app\n"