gistfile1.hs

import Control.Monad (void)
import Control.Applicative
import Data.Foldable (for_)
import Data.Monoid
import Text.Printf

data Attributed m w a = Attributed (m a) w
  
instance Functor m => Functor (Attributed m w) where
  fmap f (Attributed m w) = Attributed (fmap f m) w

instance (Monoid w, Applicative m) => Applicative (Attributed m w)
  where 
    pure a = Attributed (pure a) mempty
    Attributed f v <*> Attributed a w = 
      Attributed (f <*> a) (v <> w)
  
infixr 0 #
vs # attr = Attributed attr (mconcat vs) 

assert p err = if p then [] else [err]

type Command a = Attributed IO [String] a

minLength :: String -> Int -> String -> [String]
minLength name n str = 
  assert (length str >= n) $
    printf "%s %s: Min-length is %d" name str n

addUserCommand :: String -> Command ()
addUserCommand user = 
  [ minLength "Username" 5 user ]
  # printf "Added user %s\n" user

setPasswordCommand :: String -> String -> Command ()
setPasswordCommand user pwd = 
  [ minLength "Password" 7 pwd ]
  # printf "Set password for user %s to '%s'\n" user pwd

newUserCommand user pwd =
  addUserCommand user *> setPasswordCommand user pwd

addUsers :: [String] -> Command ()
addUsers users =
  for_ users $ \userName -> 
    case userName of 
     's':_ -> addUserCommand userName
     _     -> pure ()

run :: Command a -> IO ()
run (Attributed command w) = case w of
  []     -> void command
  errors -> for_ errors $ \e -> printf "error: %s\n" e
  
run_unsafe (Attributed m w) = m