X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FUsernames.hs;h=e31b118405c908c1eab3e09b6fc54b43d3e18cae;hp=6f2fb2874108bd436a18ad0aedde8ad4db5112a3;hb=15fd6f764f88f79424d7caaba564e57df564b532;hpb=dd4abc21674b98bc55a3775291a8667dffec2863 diff --git a/src/Usernames.hs b/src/Usernames.hs index 6f2fb28..e31b118 100644 --- a/src/Usernames.hs +++ b/src/Usernames.hs @@ -4,27 +4,52 @@ -- to watch. This is all to avoid an orphan instance of Configured -- for [String] if we had defined one in e.g. OptionalConfiguration. -- -module Usernames +module Usernames ( Usernames(..) ) where -- DC is needed only for the DCT.Configured instance of String. import qualified Data.Configurator as DC() import qualified Data.Configurator.Types as DCT -import Data.Data (Data) -import System.Console.CmdArgs.Default (Default(..)) -import Data.Typeable (Typeable) +import Data.Data ( Data ) +import Data.Monoid ( Monoid(..) ) +import Data.Typeable ( Typeable ) +import System.Console.CmdArgs.Default ( Default(..) ) +-- | Wrapper around a list of strings (usernames). +-- newtype Usernames = Usernames { get_usernames :: [String] } deriving (Data, Show, Typeable) instance Default Usernames where + -- | The default list of usernames is empty. + -- def = Usernames [] +-- | The 'Monoid' instance for 'Usernames' uses an +-- 'Monoid' instance for lists. +-- +instance Monoid Usernames where + -- | The \"empty\" 'Usernames' simply wraps an empty list. + mempty = Usernames [] + + -- | This mappend is a little funny; it always chooses the second + -- list if that list is nonempty. Otherwise, it chooses the + -- first. This is actually associative! + u1 `mappend` u2 + | null (get_usernames u2) = u1 + | otherwise = u2 + + instance DCT.Configured Usernames where + -- | This allows us to read a 'Usernames' object out of a + -- Configurator config file. By default Configurator wouldn't know + -- what to do, so we have to tell it that we expect a list, and if + -- that list has strings in it, we can apply the Usernames + -- constructor to it. convert (DCT.List xs) = fmap Usernames (mapM convert_string xs) where