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
Alex's Blog
IT stuff
Tuesday, December 31, 2019
Validated Hamlet Textarea Form Field
Here is my custom textarea field that validates correct hamlet content
Saturday, November 16, 2019
Thursday, September 12, 2019
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
Tuesday, January 01, 2019
transfer github repo and change committers email
mixture of these:
- https://help.github.com/articles/importing-a-git-repository-using-the-command-line/
- https://help.github.com/articles/changing-author-info/#platform-linux/
Saturday, December 22, 2018
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)
Thursday, November 08, 2018
Cache GIT password for some time
# Set git to use the credential memory cache git config --global credential.helper cache # Set the cache to timeout after 1 hour (setting is in seconds) git config --global credential.helper 'cache --timeout=3600'
Thursday, October 25, 2018
multiple monitors .xsession
xrandr --output HDMI2 --mode 1280x1024 xrandr --output HDMI1 --mode 1920x1080 --right-of HDMI2 xrandr --output DP1 --mode 1680x1050 --right-of HDMI1 xsetroot -solid grey & cwm
check git project status (only first level)
#!/bin/sh
clear
for d in `find . -name .git | sed -e 's|^./||' -e 's|/.git$||' | grep -v '/'`; do
echo
cd $d
echo "================================================="
pwd
git pull
git st
cd -
done
Subscribe to:
Comments (Atom)