module Data.Configurator.Types.Internal
(
ConfigCache(..)
, AutoConfig(..)
, Worth(..)
, Name
, Value(..)
, Binding
, Path
, Directive(..)
, ParseError(..)
, ConfigError(..)
, ConfigErrorLocation(..)
, ConversionError(..)
, ConversionErrorWhy(..)
, defaultConversionError
, MultiErrors
, singleError
, toErrors
, KeyError(..)
, Interpolate(..)
, Pattern(..)
, exact
, prefix
, ChangeHandler
) where
import Control.Exception
import Data.Data (Data)
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Hashable (Hashable(..))
import Data.IORef (IORef)
import Data.List (isSuffixOf)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable, TypeRep)
import Data.Scientific(Scientific)
import Prelude hiding (lookup)
import qualified Data.HashMap.Lazy as H
import qualified Data.CritBit.Map.Lazy as CB
data Worth a = Required { worth :: a }
| Optional { worth :: a }
deriving (Show, Typeable)
instance IsString (Worth FilePath) where
fromString = Required
instance (Eq a) => Eq (Worth a) where
a == b = worth a == worth b
instance (Hashable a) => Hashable (Worth a) where
hashWithSalt salt v = hashWithSalt salt (worth v)
data ConfigCache = ConfigCache {
cfgAuto :: Maybe AutoConfig
, cfgPaths :: IORef [(Name, Worth Path)]
, cfgMap :: IORef (CB.CritBit Name Value)
, cfgSubs :: IORef (H.HashMap Pattern [ChangeHandler])
}
instance Functor Worth where
fmap f (Required a) = Required (f a)
fmap f (Optional a) = Optional (f a)
type ChangeHandler = Name
-> Maybe Value
-> IO ()
data Pattern = Exact Name
| Prefix Name
deriving (Eq, Show, Typeable, Data)
exact :: Text -> Pattern
exact = Exact
prefix :: Text -> Pattern
prefix p = Prefix (p `T.snoc` '.')
instance IsString Pattern where
fromString s
| ".*" `isSuffixOf` s = Prefix . T.init . T.pack $ s
| otherwise = Exact (T.pack s)
instance Hashable Pattern where
hashWithSalt salt (Exact n) = hashWithSalt salt n
hashWithSalt salt (Prefix n) = hashWithSalt salt n
data ParseError = ParseError FilePath String
deriving (Show, Typeable)
instance Exception ParseError
data ConfigError = ConfigError {
configErrorLocation :: ConfigErrorLocation
, configConversionError :: Maybe [ConversionError]
} deriving (Eq, Show, Typeable)
instance Exception ConfigError
data ConfigErrorLocation
= KeyMissing [Name]
| Key FilePath Name
deriving (Eq, Show, Typeable)
data ConversionError = ConversionError {
conversionErrorLoc :: Text,
conversionErrorWhy :: ConversionErrorWhy,
conversionErrorVal :: !(Maybe Value),
conversionErrorType :: !(Maybe TypeRep),
conversionErrorMsg :: !(Maybe Text)
} deriving (Eq, Show, Typeable)
instance Exception ConversionError
data ConversionErrorWhy =
MissingValue
| ExtraValues
| ExhaustedValues
| TypeError
| ValueError
| MonadFail
| OtherError
deriving (Eq, Typeable, Show)
defaultConversionError :: ConversionError
defaultConversionError =
ConversionError "" OtherError Nothing Nothing Nothing
type MultiErrors a = Maybe (DList a)
singleError :: a -> MultiErrors a
singleError = Just . DList.singleton
toErrors :: MultiErrors a -> [a]
toErrors = maybe [] DList.toList
data KeyError = KeyError Name
deriving (Show, Typeable)
instance Exception KeyError
data AutoConfig = AutoConfig {
interval :: Int
, onError :: SomeException -> IO ()
} deriving (Typeable)
instance Show AutoConfig where
show c = "AutoConfig {interval = " ++ show (interval c) ++ "}"
type Name = Text
type Path = Text
type Binding = (Name,Value)
data Directive = Import Path
| Bind Name Value
| Group Name [Directive]
| DirectiveComment Directive
deriving (Eq, Show, Typeable, Data)
data Value = Bool Bool
| String Text
| Number Scientific
| List [Value]
deriving (Eq, Show, Typeable, Data)
data Interpolate = Literal Text
| Interpolate Text
deriving (Eq, Show)