Merge branch 'master' of github.com:digitallyinduced/haskellframework

Guide/hsx.markdown

@@ -161,4 +161,20 @@ Html Comments are supported and can be used like this:
     <!-- Begin of Main Section -->
     <h1>Hello</h1>
 </div>
+```
+
+#### Empty Attributes
+
+HSX allows you to write empty attributes like these:
+
+```haskell
+[hsx|
+    <input disabled/>
+|]
+```
+
+The underlying html library blaze currently does not support empty html attribute. Therefore empty attributes are implemented by setting the attribute value to the attribute name. [This is valid html supported by all browsers.](https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes). Therefore the generated html looks like this:
+
+```html
+<input disabled="disabled"/>
 ```

Guide/recipes.markdown

@@ -131,3 +131,39 @@ In case the id is hardcoded, you can just type UUID value with the right type si
 ```haskell
 let projectId = "ca63aace-af4b-4e6c-bcfa-76ca061dbdc6" :: Id Project
 ```
+
+## Making a dynamic Login/Logout button
+
+Depending on the `user` object from the viewContext, we can tell that there is no user logged in when the `user` is `Nothing`, and confirm someone is logged in if the `user` is a `Just user`. Here is an example of a navbar, which has a dynamic Login/Logout button. You can define this in your View/Layout to reuse this in your Views.
+
+```haskell
+type Html = HtmlWithContext ViewContext
+
+navbar :: Html
+navbar = [hsx|
+<nav class="navbar navbar-expand-lg navbar-light bg-light">
+  <a class="navbar-brand" href="#">IHP Blog</a>
+  <button class="navbar-toggler" type="button" data-toggle="collapse" data-target="#navbarSupportedContent" aria-controls="navbarSupportedContent" aria-expanded="false" aria-label="Toggle navigation">
+    <span class="navbar-toggler-icon"></span>
+  </button>
+
+  <div class="collapse navbar-collapse" id="navbarSupportedContent">
+    <ul class="navbar-nav mr-auto">
+      <li class="nav-item">
+        <a class="nav-link" href={PostsAction}>Posts</a>
+      </li>
+    </ul>
+    {loginLogoutButton}
+  </div>
+</nav>
+|]
+    where
+        loginLogoutButton :: Html
+        loginLogoutButton = case (get #user viewContext) of
+            Just user -> [hsx|<a class="js-delete js-delete-no-confirm text-secondary" href={DeleteSessionAction}>Logout</a>|]
+            Nothing -> [hsx|<a class="text-secondary" href={NewSessionAction}>Login</a>|]
+```
+
+You can see this code in action in the [`auth` branch from our example blog](https://github.com/digitallyinduced/ihp-blog-example-app/blob/auth/Web/View/Layout.hs).
+
+Protip: If the `user` is a `Just user` you can use the user object to run specific actions or retrieve information from it. This way you could display the username of the logged in user above the logout button.

IHP/HtmlSupport/Parser.hs

@@ -126,11 +126,24 @@ hsxSplicedAttributes = do
 hsxNodeAttribute = do
     key <- hsxAttributeName
     space
-    _ <- char '='
-    space
-    value <- hsxQuotedValue <|> hsxSplicedValue
-    space
-    pure (StaticAttribute key value)
+
+    -- Boolean attributes like <input disabled/> will be represented as <input disabled="disabled"/>
+    -- as there is currently no other way to represent them with blaze-html.
+    --
+    -- This is ok, see: https://html.spec.whatwg.org/multipage/common-microsyntaxes.html#boolean-attributes
+    let attributeWithoutValue = do
+            pure (StaticAttribute key (TextValue key))
+
+    -- Parsing normal attributes like <input value="Hello"/>
+    let attributeWithValue = do
+            _ <- char '='
+            space
+            value <- hsxQuotedValue <|> hsxSplicedValue
+            space
+            pure (StaticAttribute key value)
+
+    attributeWithValue <|> attributeWithoutValue
+
 
 hsxAttributeName :: Parser Text
 hsxAttributeName = do

IHP/SchemaCompiler.hs

@@ -126,6 +126,8 @@ compileTypes options schema@(Schema statements) =
                   <> "import qualified Data.Proxy\n"
                   <> "import GHC.Records\n"
                   <> "import Data.Data\n"
+                  <> "import qualified Data.String.Conversions\n"
+                  <> "import qualified Data.Text.Encoding\n"
                   <> "import Database.PostgreSQL.Simple.Types (Query (Query), Binary ( .. ))\n"
 
 compileStatementPreview :: [Statement] -> Statement -> Text
@@ -311,7 +313,7 @@ compileEnumDataDefinitions enum@(CreateEnumType { name, values }) =
         "data " <> modelName <> " = " <> (intercalate " | " valueConstructors) <> " deriving (Eq, Show, Read, Enum)\n"
         <> "instance FromField " <> modelName <> " where\n"
         <> indent (unlines (map compileFromFieldInstanceForValue values))
-        <> "    fromField field (Just value) = returnError ConversionFailed field \"Unexpected value for enum value\"\n"
+        <> "    fromField field (Just value) = returnError ConversionFailed field (\"Unexpected value for enum value. Got: \" <> Data.String.Conversions.cs value)\n"
         <> "    fromField field Nothing = returnError UnexpectedNull field \"Unexpected null for enum value\"\n"
         <> "instance Default " <> modelName <> " where def = " <> tableNameToModelName (unsafeHead values) <> "\n"
         <> "instance ToField " <> modelName <> " where\n" <> indent (unlines (map compileToFieldInstanceForValue values))
@@ -320,7 +322,7 @@ compileEnumDataDefinitions enum@(CreateEnumType { name, values }) =
     where
         modelName = tableNameToModelName name
         valueConstructors = map tableNameToModelName values
-        compileFromFieldInstanceForValue value = "fromField field (Just " <> tshow value <> ") = pure " <> tableNameToModelName value
+        compileFromFieldInstanceForValue value = "fromField field (Just value) | value == (Data.Text.Encoding.encodeUtf8 " <> tshow value <> ") = pure " <> tableNameToModelName value
         compileToFieldInstanceForValue value = "toField " <> tableNameToModelName value <> " = toField (" <> tshow value <> " :: Text)"
         compileInputValue value = "inputValue " <> tableNameToModelName value <> " = " <> tshow value <> " :: Text"
 

lib/IHP/Makefile.dist

@@ -122,7 +122,7 @@ build/bin/RunUnoptimizedProdServer: Main.hs build/bin static/prod.js static/prod
 	rm -f build/bin/RunProdServer
 	ln -s `basename $@` build/bin/RunProdServer
 
-build/bin/RunOptimizedProdServer: Main.hs build/bin static/prod.js static/prod.css ## Full production build with all ghc optimizations (takes a while)
+build/bin/RunOptimizedProdServer: Main.hs build/bin static/prod.js static/prod.css build/Generated/Types.hs ## Full production build with all ghc optimizations (takes a while)
 	mkdir -p build/RunOptimizedProdServer
 	ghc -O2 ${GHC_OPTIONS} ${PROD_GHC_OPTIONS} $< -o $@ -odir build/RunOptimizedProdServer -hidir build/RunOptimizedProdServer
 	chmod +x $<