Tuesday, December 31, 2019

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

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

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


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/
1. clone the old repo with bare git clone --bare https://external-host.com/extuser/repo.git foo cd foo 2. use this github script https://help.github.com/articles/changing-author-info/#platform-linux and change the variables 3. create a new github repo 4. push to the new repo git push --mirror https://github.com/ghuser/repo.git

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