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:
Posts (Atom)