Commit 0f1bd7793c8d3d4194a8eb24c7abaebd7f054caa - inf-dict

+27

-9

src/Main.hs less more

24	24	conn <- getContext
25	25	liftIO (mote conn)
26	26
	27	unwrap :: Maybe a -> (a -> ActionCtxT ctx IO ()) -> ActionCtxT ctx IO ()
	28	unwrap Nothing _ = setStatus status404
	29	unwrap (Just x) f = f x
	30
27	31	main :: IO ()
28	32	main = do
29	33	dbLoc <- maybe "test.db" id `fmap` lookupEnv "DB_LOC"

31	35	conn <- open dbLoc
32	36	runSpock port $ spockT id $ prehook (return conn) $ do
33	37	middleware $ staticPolicy (mempty <> hasPrefix "static")
	38
34	39	get root $ do
35	40	html (rPage "welcome to the dictionary yo")
	41
36	42	get "add" $ do
37	43	ls <- db allLanguages
38	44	html (rPage (rAdd ls))
	45
39	46	get "search" $ do
40	47	html (rPage rSearch)
	48
41	49	get "word" $ do
42	50	es <- db getAllWords
43	51	respondWith es
44	52	post "word" $ do
45		ps <- params
46		case paramsToEntry ps of
47		Nothing -> setStatus status404
48		Just e -> do
49		i <- db (addWord e)
50		redirect (pack ("/word/" ++ show i))
	53	ps <- paramsToEntry <$> params
	54	unwrap ps $ \ e -> do
	55	i <- db (addWord e)
	56	redirect (pack ("/word/" ++ show i))
	57
51	58	get ("word" <//> var) $ \ w -> do
52	59	eM <- db (getWordById w)
53		case eM of
54		Just e -> respondWith [e]
55		~~Nothing -> setStatus status404~~
	60	unwrap eM $ \ e -> respondWith [e]
	61	post ("word" <//> var) $ \ w -> do
	62	ps <- paramsToEntry <$> params
	63	unwrap ps $ \ e -> do
	64	db (updateWord w e)
	65	redirect (pack ("/word/" ++ show w))
	66
	67	get ("word" <//> var <//> "edit") $ \ w -> do
	68	eM <- db (getWordById w)
	69	ls <- db allLanguages
	70	unwrap eM $ html . rPage . rEdit w ls
	71
56	72	get ("word" <//> "search" <//> var) $ \ t -> do
57	73	db (searchAll t) >>= respondWith
	74
58	75	get ("word" <//> "search" <//> "by-word" <//> var) $ \ t -> do
59	76	db (searchWord t) >>= respondWith
	77
60	78	get ("word" <//> "search" <//> "by-meaning" <//> var) $ \ t -> do
61	79	db (searchMeaning t) >>= respondWith

+42

-1

src/Render.hs less more

45	45	div_ [ class_ "meaning" ] $ toHtml (eMeaning e)
46	46	when (eNotes e /= "") $
47	47	div_ [ class_ "notes" ] $ toHtml (eNotes e)
	48	ul_ [ class_ "links" ] $ do
	49	li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e) ++ "/edit")) ] "edit"
	50	li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e))) ] "link"
48	51
49	52	rSearch :: Html ()
50	53	rSearch = form_ [ name_ "search" ] $ do
51	54	input_ [ type_ "text", name_ "query" ]
52	55
53	56	rAdd :: [Language] -> Html ()
54		rAdd ls = form_ [ name_ "add", action_ "/word", method_ "POST" ] $ do
	57	rAdd ls = form_ [ name_ "add", action_ "/word/", method_ "POST" ] $ do
55	58	div_ $ do
56	59	label_ "Language: "
57	60	select_ [ name_ "lang" ] $ sequence_

71	74	label_ "Notes: "
72	75	textarea_ [ rows_ "4", cols_ "100", name_ "notes" ] ""
73	76	div_ $ input_ [ type_ "submit" ]
	77
	78
	79	rEdit :: Integer -> [Language] -> Entry -> Html ()
	80	rEdit w ls e = form_ [ name_ "edit"
	81	, action_ (pack ("/word/" ++ show w))
	82	, method_ "POST"
	83	] $ do
	84	div_ $ do
	85	label_ "Language: "
	86	select_ [ name_ "lang" ] $ sequence_
	87	[ option_ [ value_ (pack (show i))
	88	, select_ (if i == langId (eLanguage e)
	89	then "true"
	90	else "false")
	91	] $ toHtml n
	92	\| Language { langId = i, langName = n } <- ls
	93	]
	94	div_ $ do
	95	label_ "Word: "
	96	input_ [ type_ "text"
	97	, name_ "word"
	98	, value_ (eWord e)
	99	]
	100	div_ $ do
	101	label_ "Transliteration: "
	102	input_ [ type_ "text"
	103	, name_ "translit"
	104	, value_ (eTranslit e)
	105	]
	106	div_ $ do
	107	label_ "Meaning: "
	108	textarea_ [ rows_ "4", cols_ "100", name_ "meaning" ] $
	109	toHtml (eMeaning e)
	110	div_ $ do
	111	label_ "Notes: "
	112	textarea_ [ rows_ "4", cols_ "100", name_ "notes" ] $
	113	toHtml (eNotes e)
	114	div_ $ input_ [ type_ "submit" ]

+12

-0

src/Types.hs less more

99	99	execute conn q entry
100	100	fromIntegral <$> lastInsertRowId conn
101	101
	102	updateWord :: Integer -> Entry -> DB ()
	103	updateWord i e conn = do
	104	let q = "UPDATE words \
	105	\ SET word=?, trans=?, meaning=?, notes=? \
	106	\ WHERE id=?"
	107	execute conn q ( eWord e
	108	, eTranslit e
	109	, eMeaning e
	110	, eNotes e
	111	, i
	112	)
	113
102	114	getWordById :: Integer -> DB (Maybe Entry)
103	115	getWordById i conn = do
104	116	let q = "SELECT w.id, w.word, w.trans, w.meaning, w.notes, l.id, l.name \

+13

-0

static/main.css less more

63	63	}
64	64
65	65	.notes {
	66	padding-top: 20px;
	67	padding-left: 40px;
66	68	font-style: italic;
67	69	}
68	70

116	118
117	119	textarea {
118	120	float: right;
	121	}
	122
	123	.links {
	124	text-align: right;
	125	}
	126
	127	.links li {
	128	display: inline;
	129	list-style-type: none;
	130	padding-left: 20px;
	131	padding-right: 20px;
119	132	}