added working register form. still needs to be saved

Handler/Register.hs

@@ -1,9 +1,61 @@
 module Handler.Register where
 
 import Import
+import Yesod.Form.Bootstrap3
+import Yesod.Form.Functions
 
 getRegisterR :: Handler Html
-getRegisterR = error "Not yet implemented: getRegisterR"
+getRegisterR = do
+               (registerWidget, registerEnctype) <- generateFormPost registerForm
+               defaultLayout $ do
+                 setTitle "Register"
+                 [whamlet|
+                      <h1>Register
+                      <form method=post action=@{RegisterR} enctype=#{registerEnctype}>
+                          ^{registerWidget}
+                 |]
 
 postRegisterR :: Handler Html
-postRegisterR = error "Not yet implemented: postRegisterR"
+postRegisterR = do
+                ((result,registerWidget), registerEnctype) <- runFormPost registerForm
+                let again error = defaultLayout $ do
+                        setTitle "Register"
+                        [whamlet|
+                        <div class="alert alert-danger fade in"><strong>Error:</strong> #{error}
+                        <h1>Register
+                        <form method=post action=@{RegisterR} enctype=#{registerEnctype}>
+                          ^{registerWidget}
+                  |]
+                case result of
+                  FormSuccess a -> defaultLayout $ [whamlet|<h1> success|]
+                  FormFailure (err:_) -> again err
+                  _ -> again "Invalid input"
+
+
+registerForm :: Html -> MForm Handler (FormResult (User,Text), Widget)
+registerForm extra = do
+           (nameRes, nameView) <- mreq textField ((withAutofocus . withPlaceholder "Username") (bfs ("Username" :: Text))) Nothing
+           (pwRes, pwView) <- mreq passwordField (bfs ("Password" :: Text)) Nothing
+           (pwcRes, pwcView) <- mreq passwordField (bfs ("Confirm password" :: Text)) Nothing
+           (emailRes, emailView) <- mreq emailField (withPlaceholder "User@mail" (bfs ("Email" :: Text))) Nothing
+           time <- lift $ liftIO getCurrentTime
+           let confirmRes = case pwRes of
+                             FormSuccess x -> case pwcRes of
+                                             FormSuccess y -> if x == y then FormSuccess x else FormFailure ["Passwords did not match"]
+                                             a -> a
+                             a -> a
+           let registerRes = (,) <$> (User <$> nameRes <*> (Just <$> confirmRes) <*> (FormSuccess time))
+                                 <*> emailRes
+           let widget = [whamlet|
+                      #{extra}
+                      <p>
+                         Username ^{fvInput nameView}
+                      <p>
+                         Password ^{fvInput pwView}
+                      <p>
+                         Confirm password ^{fvInput pwcView}
+                      <p>
+                         Email ^{fvInput emailView}
+                      <input type=submit value="register">
+                    |]
+           return (registerRes, widget)

config/settings.yml

@@ -25,5 +25,6 @@ database:
   database: "_env:PGDATABASE:neat"
   poolsize: "_env:PGPOOLSIZE:10"
 
-copyright: Insert copyright statement here
+copyright: For all services on this Page a FULL API-Key is required! This page is run by an individual person, who is not affiliated with CCP in any way (other than he plays EVE). The service is currently in development and may break at any time. There is no backup-service and the data you enter may be lost when the servers harddrive crashes. CCP can not be held responsible for any malfunction of this page.
+           This page may improve your trading-ability, but we can't be made responsible for anything. Your PC may malfunction, explode or a llama may appear in your room - don't sue us for that.
 #analytics: UA-YOURCODE

templates/default-layout-wrapper.hamlet

@@ -27,7 +27,8 @@ $newline never
       <header>
       <div id="main" role="main">
         ^{pageBody pc}
-      <footer>
+    <footer class="footer">
+      <div class="container">
         #{appCopyright $ appSettings master}
 
     $maybe analytics <- appAnalytics $ appSettings master

templates/default-layout.lucius

@@ -0,0 +1,20 @@
+/* Sticky footer styles
+-------------------------------------------------- */
+html {
+  position: relative;
+  min-height: 100%;
+}
+body {
+  /* Margin bottom by footer height */
+  margin-bottom: 60px;
+}
+.footer {
+  font-size:x-small;
+  position: absolute;
+  color: #888888;
+  bottom: 0;
+  width: 100%;
+  /* Set the fixed height of the footer here */
+  height: 60px;
+  background-color: #f5f5f5;
+}