Adds documentation.

master
Abhinav Sarkar 2015-06-30 00:15:17 +05:30
parent 9df8065b0d
commit 99aae529d1
4 changed files with 34 additions and 9 deletions

View File

@ -1,7 +1,7 @@
{-| {-|
Module : Network.IRC Module : Network.IRC
Description : A simple and extensible IRC bot. Description : A simple and extensible IRC bot.
Copyright : (c) Abhinav Sarkar, 2014 Copyright : (c) Abhinav Sarkar, 2014-2015
License : Apache-2.0 License : Apache-2.0
Maintainer : abhinav@abhinavsarkar.net Maintainer : abhinav@abhinavsarkar.net
Stability : experimental Stability : experimental

View File

@ -1,11 +1,13 @@
{-| {-|
Module : Network.IRC.Client Module : Network.IRC.Client
Description : The IRC bot client used to create and run a bot. Description : The IRC bot client used to create and run a bot.
Copyright : (c) Abhinav Sarkar, 2014 Copyright : (c) Abhinav Sarkar, 2014-2015
License : Apache-2.0 License : Apache-2.0
Maintainer : abhinav@abhinavsarkar.net Maintainer : abhinav@abhinavsarkar.net
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
The IRC bot client used to create and run a bot.
-} -}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}

View File

@ -1,10 +1,22 @@
{-|
Module : Network.IRC.Client
Description : Extensible configuration for the IRC bot.
Copyright : (c) Abhinav Sarkar, 2014-2015
License : Apache-2.0
Maintainer : abhinav@abhinavsarkar.net
Stability : experimental
Portability : POSIX
Extensible configuration for the IRC bot.
-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification, GADTs #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ExistentialQuantification, GADTs #-}
module Network.IRC.Configuration module Network.IRC.Configuration
( Name ( Name
, Value (..) , Value (..)
, Configuration
, Configurable (..) , Configurable (..)
, Configuration
, fromMap , fromMap
, lookup , lookup
, require , require
@ -16,8 +28,10 @@ import qualified ClassyPrelude as P
import ClassyPrelude hiding (lookup) import ClassyPrelude hiding (lookup)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
-- | Name of a configuration property.
type Name = Text type Name = Text
-- | Typeclass for the types that can be used as values in 'Configuration'.
class Configurable a where class Configurable a where
fromValue :: Value -> Maybe a fromValue :: Value -> Maybe a
@ -58,22 +72,31 @@ instance Configurable a => Configurable [a] where
fromValue = valueToList fromValue = valueToList
toValue = listToValue toValue = listToValue
data Value = String Text -- | Value of a configuration property.
| Number Integer data Value = String Text -- ^ A text value.
| Boolean Bool | Number Integer -- ^ An integer value.
| List [Value] | Boolean Bool -- ^ A boolean value.
| List [Value] -- ^ A list of values as a value.
deriving (Eq, Show) deriving (Eq, Show)
newtype Configuration = Configuration { configMap :: Map Name Value } deriving (Show) -- | A configuration data which can be used to look up properties.
newtype Configuration = Configuration { configMap :: Map Name Value } deriving (Show, Eq)
-- | Creates a 'Configuration' from a map of 'Name's to 'Value's.
fromMap :: Map Name Value -> Configuration fromMap :: Map Name Value -> Configuration
fromMap = Configuration fromMap = Configuration
-- | Looks up a property in the 'Configuration' by the given 'Name'.
-- Returns 'Nothing' if the property is not found or is of wrong type.
lookup :: (Configurable a) => Name -> Configuration -> Maybe a lookup :: (Configurable a) => Name -> Configuration -> Maybe a
lookup name Configuration {..} = join . map fromValue $ P.lookup name configMap lookup name Configuration {..} = join . map fromValue $ P.lookup name configMap
-- | Looks up a property in the 'Configuration' by the given 'Name'.
-- Fails with an error if the property is not found or is of wrong type.
require :: (Configurable a) => Name -> Configuration -> a require :: (Configurable a) => Name -> Configuration -> a
require n = fromJust . lookup n require n = fromJust . lookup n
-- | Looks up a property in the 'Configuration' by the given 'Name'.
-- Returns the given default if the property is not found or is of wrong type.
lookupDefault :: (Configurable a) => Name -> Configuration -> a -> a lookupDefault :: (Configurable a) => Name -> Configuration -> a -> a
lookupDefault n c v = fromMaybe v $ lookup n c lookupDefault n c v = fromMaybe v $ lookup n c

View File

@ -1,7 +1,7 @@
{-| {-|
Module : Network.IRC.Types Module : Network.IRC.Types
Description : Types for the IRC bot and the message handlers. Description : Types for the IRC bot and the message handlers.
Copyright : (c) Abhinav Sarkar, 2014 Copyright : (c) Abhinav Sarkar, 2014-2015
License : Apache-2.0 License : Apache-2.0
Maintainer : abhinav@abhinavsarkar.net Maintainer : abhinav@abhinavsarkar.net
Stability : experimental Stability : experimental