Skip to content

Instantly share code, notes, and snippets.

@philipnilsson
Created February 25, 2014 00:58

Revisions

  1. philipnilsson created this gist Feb 25, 2014.
    55 changes: 55 additions & 0 deletions gistfile1.hs
    Original 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