Created
February 25, 2014 00:58
Revisions
-
philipnilsson created this gist
Feb 25, 2014 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -0,0 +1,55 @@ 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