dev: web: simplify types a little (#1229)
This commit is contained in:
		
							parent
							
								
									bc4c0b4de4
								
							
						
					
					
						commit
						581831b16d
					
				| @ -84,11 +84,12 @@ data App = App | |||||||
| -- usually require access to the AppRoute datatype. Therefore, we | -- usually require access to the AppRoute datatype. Therefore, we | ||||||
| -- split these actions into two functions and place them in separate files. | -- split these actions into two functions and place them in separate files. | ||||||
| mkYesodData "App" $(parseRoutesFile "config/routes") | mkYesodData "App" $(parseRoutesFile "config/routes") | ||||||
|  | -- ^ defines things like: | ||||||
|  | -- type Handler = HandlerFor App   -- HandlerT App IO, https://www.yesodweb.com/book/routing-and-handlers#routing-and-handlers_handler_monad | ||||||
|  | -- type Widget = WidgetFor App ()  -- WidgetT App IO (), https://www.yesodweb.com/book/widgets | ||||||
| 
 | 
 | ||||||
| -- | A convenience alias. |  | ||||||
| type AppRoute = Route App | type AppRoute = Route App | ||||||
| 
 | type Form a = Html -> MForm Handler (FormResult a, Widget) | ||||||
| type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget) |  | ||||||
| 
 | 
 | ||||||
| -- Please see the documentation for the Yesod typeclass. There are a number | -- Please see the documentation for the Yesod typeclass. There are a number | ||||||
| -- of settings which can be configured by overriding methods here. | -- of settings which can be configured by overriding methods here. | ||||||
|  | |||||||
| @ -15,7 +15,7 @@ import Hledger.Web.Import | |||||||
| import Hledger.Web.Widget.Common | import Hledger.Web.Widget.Common | ||||||
|        (fromFormSuccess, helplink, journalFile404, writeJournalTextIfValidAndChanged) |        (fromFormSuccess, helplink, journalFile404, writeJournalTextIfValidAndChanged) | ||||||
| 
 | 
 | ||||||
| editForm :: FilePath -> Text -> Markup -> MForm Handler (FormResult Text, Widget) | editForm :: FilePath -> Text -> Form Text | ||||||
| editForm f txt = | editForm f txt = | ||||||
|   identifyForm "edit" $ \extra -> do |   identifyForm "edit" $ \extra -> do | ||||||
|     (tRes, tView) <- mreq textareaField fs (Just (Textarea txt)) |     (tRes, tView) <- mreq textareaField fs (Just (Textarea txt)) | ||||||
|  | |||||||
| @ -25,15 +25,17 @@ import Text.Megaparsec (bundleErrors, eof, parseErrorTextPretty, runParser) | |||||||
| import Yesod | import Yesod | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
|  | import Hledger.Web.Foundation -- (App, Form, Handler, Widget) | ||||||
| import Hledger.Web.Settings (widgetFile) | import Hledger.Web.Settings (widgetFile) | ||||||
| 
 | 
 | ||||||
| addModal :: | -- addModal :: | ||||||
|      ( MonadWidget m | --      ( MonadWidget m | ||||||
|      , r ~ Route (HandlerSite m) | --      , r ~ Route (HandlerSite m) | ||||||
|      , m ~ WidgetFor (HandlerSite m) | --      , m ~ WidgetFor (HandlerSite m) | ||||||
|      , RenderMessage (HandlerSite m) FormMessage | --      , RenderMessage (HandlerSite m) FormMessage | ||||||
|      ) | --      ) | ||||||
|   => r -> Journal -> Day -> m () | --   => r -> Journal -> Day -> m () | ||||||
|  | addModal :: Route App -> Journal -> Day -> Widget | ||||||
| addModal addR j today = do | addModal addR j today = do | ||||||
|   (addView, addEnctype) <- generateFormPost (addForm j today) |   (addView, addEnctype) <- generateFormPost (addForm j today) | ||||||
|   [whamlet| |   [whamlet| | ||||||
| @ -48,12 +50,16 @@ addModal addR j today = do | |||||||
|           ^{addView} |           ^{addView} | ||||||
| |] | |] | ||||||
| 
 | 
 | ||||||
|  | -- addForm :: | ||||||
|  | --      (site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m) | ||||||
|  | --   => Journal | ||||||
|  | --   -> Day | ||||||
|  | --   -> Markup | ||||||
|  | --   -> MForm m (FormResult Transaction, WidgetFor site ()) | ||||||
| addForm :: | addForm :: | ||||||
|      (site ~ HandlerSite m, RenderMessage site FormMessage, MonadHandler m) |   (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) =>  | ||||||
|   => Journal |   Journal -> Day -> Markup -> | ||||||
|   -> Day |   MForm m (FormResult Transaction, WidgetFor (HandlerSite m) ()) | ||||||
|   -> Markup |  | ||||||
|   -> MForm m (FormResult Transaction, WidgetFor site ()) |  | ||||||
| addForm j today = identifyForm "add" $ \extra -> do | addForm j today = identifyForm "add" $ \extra -> do | ||||||
|   (dateRes, dateView) <- mreq dateField dateFS Nothing |   (dateRes, dateView) <- mreq dateField dateFS Nothing | ||||||
|   (descRes, descView) <- mreq textField descFS Nothing |   (descRes, descView) <- mreq textField descFS Nothing | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user