Validated Hamlet Textarea Form Field

Here is my custom textarea field that validates correct hamlet content

in the Form:
...
  (hamletHtmlResult, hamletHtmlView) <- mreq validatedHamletTextareaField
...

the field:

validatedHamletTextareaField :: Field (HandlerFor App) Textarea
validatedHamletTextareaField = checkM isValidHamlet textareaField
  where
    isValidHamlet :: Textarea -> Handler (Either AppMessage Textarea)
    isValidHamlet textarea@(Textarea text) = do
      eitherParsedTemplate <- tryParse text
      return $
        case eitherParsedTemplate of
          Left _ -> Left MsgGlobalInvalidHamlet
          Right _ -> Right $ Textarea text
      where
        tryParse :: Text -> Handler (Either SomeException HamletTemplate)
        tryParse text = try $ parseHamletTemplate defaultHamletSettings $ unpack text

NixOS haskell infrastructure setup

User's Guide to the Haskell Infrastructure
Haskell/Yesod from scratch with Nix on Mac OS X

haskell LDAP TLS

import Ldap.Client as Ldap
import qualified Ldap.Client.Bind as Ldap

ldapTest :: App -> IO Text
ldapTest app = do
  let ldapHost = .....
  let ldapPort = .....
  let ldapBindDn = .....
  let ldapBindPassword = .....
  let tlsSettings = if .....
                    then Ldap.defaultTlsSettings
                    else Ldap.insecureTlsSettings
  res <- Ldap.with (Ldap.Tls ldapHost tlsSettings) (fromInteger ldapPort) $ \l -> do
    Ldap.bind l
      (Dn ldapBindDn)
      (Password $ encodeUtf8 ldapBindPassword)
    Ldap.search l
      (Dn "dc=.....")
      (typesOnly False)
      (And [ Attr "objectCategory" := "Person"
           , Attr "objectClass" := "user"
           , Attr "sAMAccountName" := encodeUtf8 "xyzuser"
           ])
      []
  case res of
    Left  e -> return $ pack $ "ERROR: " ++ show e
    Right t -> return $ pack $ "OK: " ++ show t

haskell package release

https://taylor.fausak.me/2016/12/05/haskell-package-checklist/
https://functor.tokyo/blog/2018-07-16-release-haskell-packages-to-hackage

CommandBuilder-Monad as EDSL (sort of WriterMonad)

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Control.Monad
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.List as L

main :: IO ()
main = do
  putStrLn "build actions"
  let actions = do
        fooAction
        barAction "aaa"
        barAction "bbb"
        do
          fooAction
          barAction "ccc"
          barAction "ddd"
        fooAction
        barAction "eee"
        barAction "fff"
  putStrLn "execute actions"                                                                                                 
  let results = execute actions
  forM_ results T.putStrLn

fooAction :: Builder
fooAction = build $ Action "foo action"

barAction :: Text -> Builder
barAction text = build $ Action $ T.concat ["bar action (", text, ")"]                                                       


build :: Action -> Builder
build action = BuilderM () [action]

execute :: Builder -> [Text]
execute (BuilderM _ actions) = L.map actionText actions

actionText :: Action -> Text
actionText (Action text) = text

data Action = Action Text
  deriving Show

data BuilderM a = BuilderM a [Action]
  deriving Show

type Builder = BuilderM ()

instance Functor BuilderM where
  fmap = liftM

instance Applicative BuilderM where
  pure  = return
  (<*>) = ap

instance Monad BuilderM where
  return a            = BuilderM a []
  BuilderM a xs >>= f = let BuilderM b ys = f a
                        in  BuilderM b (xs++ys)

$ stack build && stack exec ...                                                       
build actions
execute actions
foo action
bar action (aaa)
bar action (bbb)
foo action
bar action (ccc)
bar action (ddd)
foo action
bar action (eee)
bar action (fff)

nixos haskell yesod package with overrides

create a new file my-stack-project.nix:

let
  pkgs = import  {};
  pkg = pkgs.haskellPackages.callCabal2nix "my-stack-project" ./. {};
in
  pkgs.haskell.lib.overrideCabal pkg (_: {
    doHaddock = false;
    postInstall = ''
      cp -r ./static $out/bin
      cp -r ./config $out/bin
    '';
  })

nixos haskell package without default.nix

create a new file my-stack-project.nix:

let
  pkgs = import  {};
in
  pkgs.haskellPackages.callCabal2nix "my-stack-project" ./. {}

nixos haskell package with default.nix

generate the default.nix with

cd my-stack-project
cabal2nix . > default.nix

create a new file my-stack-project.nix:

let
  pkgs = import  {};
in
  pkgs.haskellPackages.callPackage ./default.nix {}

haskell set file modes

import System.Posix.Files (setFileMode, groupReadMode)
import System.Directory (getDirectoryContents)

tmpFilePaths <- liftIO $ getDirectoryContents staticDir
forM_ tmpFilePaths (\path -> do
                               liftIO $ setFileMode path groupReadMode
                   )

Yesod embed json in html

getPersonListR :: Handler Html
getPersonListR = do
  urlRender <- getUrlRender
  personEnts <- runDB $ selectList [] [Asc PersonId]
  let jData = map (\(Entity personId person) ->
                      JPerson { jPersonPerson = person
                              , jPersonEditFormUrl = urlRender $ PersonEditFormR personId }
                  ) personEnts
  jsonData <- returnJson jData >>= return . toJsonText
  defaultLayout $ do
    toWidgetBody [julius|var data = #{rawJS jsonData}|]
    $(widgetFile "person_list")

data JPerson = JPerson
  { jPersonPerson :: Person
  , jPersonEditFormUrl :: Text
  }

Build your Haskell project continuously

see here:
https://kseo.github.io/posts/2017-01-28-build-your-haskell-project-continuously.html

Haskell for Web Developers

a bit outdated but very good reading: Haskell for Web Developers

haskell yesod curl POST request ... handling CSRF

get the cookie with token in it:

$ curl -c cookie.txt http://localhost:3000/

$ cat cookie.txt 
# Netscape HTTP Cookie File
# http://curl.haxx.se/docs/http-cookies.html
# This file was generated by libcurl! Edit at your own risk.

#HttpOnly_localhost FALSE / FALSE 1451524550 _SESSION gxV1yVNefLhiS7K3/ukfWWi5GXfD7wXfwJFYDXk3fz/HvyPqcSIcU7BBIKdOrj0jrpcU9DroL0+ioD3rr8cbvCSy+A+jPDpt/8kkiSPjYE86cGyTiueVo2cOGWcc8=
localhost FALSE / FALSE 0 XSRF-TOKEN seQLdve8GY


use token:

$ curl -v \
    --cookie cookie.txt \
    -c cookie.txt \
    -H "x-xsrf-token: seQLdve8GY" \
    -H "Accept: application/json" \
    -H "Content-Type: application/json" \
    -X POST \
    -d '{"foo":"bar", ...}' \
    http://localhost:3000/updateDruckprodukt

yesod persistent enum type

State.hs

{-# LANGUAGE TemplateHaskell #-}
module State where

import Database.Persist.TH
import Prelude

data State = New | Released
    deriving (Show, Read, Eq)
derivePersistField "State"

models

MyModel json
    state S.State
    createdAt UTCTime default=CURRENT_TIME

Model.hs

import qualified State as S

instance ToJSON S.State where
    toJSON S.New = String "New"
    toJSON S.Released = String "Released"

instance FromJSON S.State where
    parseJSON (String "New") = pure S.New
    parseJSON (String "Released") = pure S.Released

haskell web-development links

General:
What I Wish I Knew When Learning Haskell 2.2 ( Stephen Diehl )
Haskell for Web Developers (clay, blaze-html, jmacro, fay, aeson, postgres-simple, acid-state, Digestive Functors, websockets, cloud haskell)

WAI:
WAI Website

Happstack:
Happstack
Happstack Book
clckwrks
A simple pasteboard app

Snap:
http://learnmeahaskell.blogspot.de/2011/05/few-notes-on-learning-snap-framework.html

Comparisons:
happstack vs. snap
Fair and Useful Comparison of Haskell Web Frameworks (Happstack, Yesod, Snap)
Comparing Haskell Web Frameworks (Happstack, Snap Scotty, Yesod)

WebSockets:
websockets
24 Days of Hackage: websockets
websocket javascript client
yesod websocket
https://github.com/yesodweb/yesod/blob/master/yesod-websockets/chat.hs

Yesod
Yesod Persistent Enums

runhaskell in cabal sandbox

mkdir foo
cd foo
cabal sandbox init
cabal install ...
cabal exec runhaskell hello.hs

haskell Writer IO monad transformer sample

module Main where

import Control.Monad.Writer (WriterT, tell, runWriterT)

main :: IO ()
main = do
  result <- runWriterT main'
  print result
  return ()

main' :: WriterT [String] IO ()
main' = do
  x <- foo
  y <- bar
  tell [show x ++ show y]
  return ()

foo :: WriterT [String] IO Int
foo = do
  tell ["foo"]
  return 42

bar :: WriterT [String] IO Int
bar = do
  tell ["bar"]
  return 43

A Concise Guide to Haskell by David Matuszek

A Concise Guide to Haskell by David Matuszek

haskell Data.Text.Format example

{-# LANGUAGE OverloadedStrings #-}

import Data.Text
import qualified Data.Text.Format as TF

main :: IO ()
main = do
     print $ TF.format "foo {}" $ TF.Only ("bar" :: Text)

     let str = "world" :: Text
     print $ TF.format strf $ TF.Only str

     let num = 123 :: Integer
     print $ TF.format multif (str, num)

strf :: TF.Format                                                                         
strf = "hello {}"                                                                         

multif :: TF.Format                                                                       
multif = "hello {} {}"

haskell shellac skeleton sample

module ShellacTest where

import System.Console.Shell
import System.Console.Shell.ShellMonad
import System.Console.Shell.Backend.Basic

react :: String -> Sh () ()
react s = shellPutStrLn $ "exec command: " ++ s

main :: IO ()
main = do
  runShell shellDescr' basicBackend ()
  where shellDescr = mkShellDescription shellCommands react
        shellDescr' = shellDescr {greetingText = Just "welcome to shellac\n  type \"quit\" or \"exit\" to quit\n  or \"?\" for help\n",
                                  prompt = \_ -> return "prompt> ",
                                  commandStyle = OnlyCommands,
                                  shellCommands = shellCommands
                                 }
        shellCommands = [exitCommand "quit", exitCommand "exit",
                         helpCommand "?"]