{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TupleSections #-}-- |-- Module: Data.Configurator-- Copyright: (c) 2011 MailRank, Inc.-- License: BSD3-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>-- Stability: experimental-- Portability: portable---- A simple (yet powerful) library for working with configuration-- files.moduleData.Configurator(-- * Configuration file format-- $format-- ** Binding a name to a value-- $binding-- *** Value types-- $types-- *** String interpolation-- $interp-- ** Grouping directives-- $group-- ** Importing files-- $import-- * TypesWorth(..)-- * Loading configuration data,autoReload,autoReloadGroups,autoConfig,empty-- * Lookup functions,lookup,lookupDefault,require-- * Notification of configuration changes-- $notify,prefix,exact,subscribe-- * Low-level loading functions,load,loadGroups,reload,subconfig,addToConfig,addGroupsToConfig-- * Helper functions,display,getMap)whereimportControl.Applicative((<$>))importControl.Concurrent(ThreadId,forkIO,threadDelay)importControl.Exception(SomeException,catch,evaluate,handle,throwIO,try)importControl.Monad(foldM,forM,forM_,join,when)importData.Configurator.Instances()importData.Configurator.Parser(interp,topLevel)importData.Configurator.Types.InternalimportData.IORef(atomicModifyIORef,newIORef,readIORef)importData.Maybe(fromMaybe,isJust)importData.Monoid(mconcat)importData.Text.Lazy.Builder(fromString,fromText,toLazyText)importData.Text.Lazy.Builder.Int(decimal)importData.Text.Lazy.Builder.RealFloat(realFloat)importData.Ratio(denominator,numerator)importPreludehiding(catch,lookup)importSystem.Environment(getEnv)importSystem.IO(hPutStrLn,stderr)importSystem.IO.Unsafe(unsafePerformIO)importSystem.Posix.Types(EpochTime,FileOffset)importSystem.PosixCompat.Files(fileSize,getFileStatus,modificationTime)importqualifiedData.Attoparsec.TextasTimportqualifiedData.Attoparsec.Text.LazyasLimportqualifiedData.HashMap.LazyasHimportqualifiedData.TextasTimportqualifiedData.Text.LazyasLimportqualifiedData.Text.Lazy.IOasLloadFiles::[WorthPath]->IO(H.HashMap(WorthPath)[Directive])loadFiles=foldMgoH.emptywheregoseenpath=doletrewrapn=constn<$>pathwpath=worthpathpath'<-rewrap<$>interpolatewpathH.emptyds<-loadOne(T.unpack<$>path')let!seen'=H.insertpathdsseennotSeenn=not.isJust.H.lookupn$seenfoldMgoseen'.filternotSeen.importsOfwpath$ds-- | Create a 'Config' from the contents of the named files. Throws an-- exception on error, such as if files do not exist or contain errors.---- File names have any environment variables expanded prior to the-- first time they are opened, so you can specify a file name such as-- @\"$(HOME)/myapp.cfg\"@.load::[WorthFilePath]->IOConfigloadfiles=fmap(Config"")$load'Nothing(map(\f->("",f))files)-- | Create a 'Config' from the contents of the named files, placing them-- into named prefixes. If a prefix is non-empty, it should end in a-- dot.loadGroups::[(Name,WorthFilePath)]->IOConfigloadGroupsfiles=fmap(Config"")$load'Nothingfilesload'::MaybeAutoConfig->[(Name,WorthFilePath)]->IOBaseConfigload'autopaths0=doletsecondf(x,y)=(x,fy)paths=map(second(fmapT.pack))paths0ds<-loadFiles(mapsndpaths)p<-newIORefpathsm<-newIORef=<<flattenpathsdss<-newIORefH.emptyreturnBaseConfig{cfgAuto=auto,cfgPaths=p,cfgMap=m,cfgSubs=s}-- | Gives a 'Config' corresponding to just a single group of the original-- 'Config'. The subconfig can be used just like the original 'Config', but-- see the documentation for 'reload'.subconfig::Name->Config->Configsubconfigg(Configrootcfg)=Config(T.concat[root,g,"."])cfg-- | Forcibly reload a 'Config'. Throws an exception on error, such as-- if files no longer exist or contain errors. If the provided 'Config' is-- a 'subconfig', this will reload the entire top-level configuration, not just-- the local section.reload::Config->IO()reload(Config_cfg@BaseConfig{..})=reloadBasecfgreloadBase::BaseConfig->IO()reloadBasecfg@BaseConfig{..}=dopaths<-readIORefcfgPathsm'<-flattenpaths=<<loadFiles(mapsndpaths)m<-atomicModifyIORefcfgMap$\m->(m',m)notifySubscriberscfgmm'=<<readIORefcfgSubs-- | Add additional files to a 'Config', causing it to be reloaded to add-- their contents.addToConfig::[WorthFilePath]->Config->IO()addToConfigpaths0cfg=addGroupsToConfig(map(\x->("",x))paths0)cfg-- | Add additional files to named groups in a 'Config', causing it to be-- reloaded to add their contents. If the prefixes are non-empty, they should-- end in dots.addGroupsToConfig::[(Name,WorthFilePath)]->Config->IO()addGroupsToConfigpaths0(Configrootcfg@BaseConfig{..})=doletfix(x,y)=(root`T.append`x,fmapT.packy)paths=mapfixpaths0atomicModifyIORefcfgPaths$\prev->(prev++paths,())reloadBasecfg-- | Defaults for automatic 'Config' reloading when using-- 'autoReload'. The 'interval' is one second, while the 'onError'-- action ignores its argument and does nothing.autoConfig::AutoConfigautoConfig=AutoConfig{interval=1,onError=const$return()}-- | Load a 'Config' from the given 'FilePath's, and start a reload-- thread.---- At intervals, a thread checks for modifications to both the-- original files and any files they refer to in @import@ directives,-- and reloads the 'Config' if any files have been modified.---- If the initial attempt to load the configuration files fails, an-- exception is thrown. If the initial load succeeds, but a-- subsequent attempt fails, the 'onError' handler is invoked.---- File names have any environment variables expanded prior to the-- first time they are opened, so you can specify a file name such as-- @\"$(HOME)/myapp.cfg\"@.autoReload::AutoConfig-- ^ Directions for when to reload and how to handle-- errors.->[WorthFilePath]-- ^ Configuration files to load.->IO(Config,ThreadId)autoReloadautopaths=autoReloadGroupsauto(map(\x->("",x))paths)autoReloadGroups::AutoConfig->[(Name,WorthFilePath)]->IO(Config,ThreadId)autoReloadGroupsAutoConfig{..}_|interval<1=error"autoReload: negative interval"autoReloadGroups_[]=error"autoReload: no paths to load"autoReloadGroupsauto@AutoConfig{..}paths=docfg<-load'(Justauto)pathsletfiles=mapsndpathsloopmeta=dothreadDelay(maxinterval1*1000000)meta'<-getMetafilesifmeta'==metathenloopmetaelse(reloadBasecfg`catch`onError)>>loopmeta'tid<-forkIO$loop=<<getMetafilesreturn(Config""cfg,tid)-- | Save both a file's size and its last modification date, so we-- have a better chance of detecting a modification on a crappy-- filesystem with timestamp resolution of 1 second or worse.typeMeta=(FileOffset,EpochTime)getMeta::[WorthFilePath]->IO[MaybeMeta]getMetapaths=forMpaths$\path->handle(\(_::SomeException)->returnNothing).fmapJust$dost<-getFileStatus(worthpath)return(fileSizest,modificationTimest)-- | Look up a name in the given 'Config'. If a binding exists, and-- the value can be 'convert'ed to the desired type, return the-- converted value, otherwise 'Nothing'.lookup::Configureda=>Config->Name->IO(Maybea)lookup(ConfigrootBaseConfig{..})name=(join.fmapconvert.H.lookup(root`T.append`name))<$>readIORefcfgMap-- | Look up a name in the given 'Config'. If a binding exists, and-- the value can be 'convert'ed to the desired type, return the-- converted value, otherwise throw a 'KeyError'.require::Configureda=>Config->Name->IOarequirecfgname=doval<-lookupcfgnamecasevalofJustv->returnv_->throwIO.KeyError$name-- | Look up a name in the given 'Config'. If a binding exists, and-- the value can be converted to the desired type, return it,-- otherwise return the default value.lookupDefault::Configureda=>a-- ^ Default value to return if 'lookup' or 'convert'-- fails.->Config->Name->IOalookupDefaultdefcfgname=fromMaybedef<$>lookupcfgname-- | Perform a simple dump of a 'Config' to @stdout@.display::Config->IO()display(ConfigrootBaseConfig{..})=print.(root,)=<<readIORefcfgMap-- | Fetch the 'H.HashMap' that maps names to values.getMap::Config->IO(H.HashMapNameValue)getMap=readIORef.cfgMap.baseCfgflatten::[(Name,WorthPath)]->H.HashMap(WorthPath)[Directive]->IO(H.HashMapNameValue)flattenrootsfiles=foldMdoPathH.emptyrootswheredoPathm(pfx,f)=caseH.lookupffilesofNothing->returnmJustds->foldM(directivepfx(worthf))mdsdirectivepfx_m(Bindname(Stringvalue))=dov<-interpolatevaluemreturn$!H.insert(T.appendpfxname)(Stringv)mdirectivepfx_m(Bindnamevalue)=return$!H.insert(T.appendpfxname)valuemdirectivepfxfm(Groupnamexs)=foldM(directivepfx'f)mxswherepfx'=T.concat[pfx,name,"."]directivepfxfm(Importpath)=letf'=relativizefpathincaseH.lookup(Required(relativizefpath))filesofJustds->foldM(directivepfxf')mds_->returnminterpolate::T.Text->H.HashMapNameValue->IOT.Textinterpolatesenv|"$"`T.isInfixOf`s=caseT.parseOnlyinterpsofLefterr->throwIO$ParseError""errRightxs->(L.toStrict.toLazyText.mconcat)<$>mapMinterpretxs|otherwise=returnswhereinterpret(Literalx)=return(fromTextx)interpret(Interpolatename)=caseH.lookupnameenvofJust(Stringx)->return(fromTextx)Just(Numberr)|denominatorr==1->return(decimal$numeratorr)|otherwise->return$realFloat(fromRationalr::Double)-- TODO: Use a dedicated Builder for Rationals instead of-- using realFloat on a Double.Just_->error"type error"_->doe<-try.getEnv.T.unpack$namecaseeofLeft(_::SomeException)->throwIO.ParseError""$"no such variable "++shownameRightx->return(fromStringx)importsOf::Path->[Directive]->[WorthPath]importsOfpath(Importref:xs)=Required(relativizepathref):importsOfpathxsimportsOfpath(Group_ys:xs)=importsOfpathys++importsOfpathxsimportsOfpath(_:xs)=importsOfpathxsimportsOf__=[]relativize::Path->Path->Pathrelativizeparentchild|T.headchild=='/'=child|otherwise=fst(T.breakOnEnd"/"parent)`T.append`childloadOne::WorthFilePath->IO[Directive]loadOnepath=does<-try.L.readFile.worth$pathcaseesofLeft(err::SomeException)->casepathofRequired_->throwIOerr_->return[]Rights->dop<-evaluate(L.eitherResult$L.parsetopLevels)`catch`\(e::ConfigError)->throwIO$caseeofParseError_err->ParseError(worthpath)errcasepofLefterr->throwIO(ParseError(worthpath)err)Rightds->returnds-- | Subscribe for notifications. The given action will be invoked-- when any change occurs to a configuration property matching the-- supplied pattern.subscribe::Config->Pattern->ChangeHandler->IO()subscribe(ConfigrootBaseConfig{..})patact=dom'<-atomicModifyIORefcfgSubs$\m->letm'=H.insertWith(++)(localPatternrootpat)[act]min(m',m')evaluatem'>>return()localPattern::Name->Pattern->PatternlocalPatternpfx(Exacts)=Exact(pfx`T.append`s)localPatternpfx(Prefixs)=Prefix(pfx`T.append`s)notifySubscribers::BaseConfig->H.HashMapNameValue->H.HashMapNameValue->H.HashMapPattern[ChangeHandler]->IO()notifySubscribersBaseConfig{..}mm'subs=H.foldrWithKeygo(return())subswherechangedOrGone=H.foldrWithKeycheck[]mwherechecknvnvs=caseH.lookupnm'ofJustv'|v/=v'->(n,Justv'):nvs|otherwise->nvs_->(n,Nothing):nvsnew=H.foldrWithKeycheck[]m'wherechecknvnvs=caseH.lookupnmofNothing->(n,v):nvs_->nvsnotifypnva=anv`catch`maybereportonErrorcfgAutowherereporte=hPutStrLnstderr$"*** a ChangeHandler threw an exception for "++show(p,n)++": "++showegop@(Exactn)actsnext=(constnext=<<)$doletv'=H.lookupnm'when(H.lookupnm/=v').mapM_(notifypnv')$actsgop@(Prefixn)actsnext=(constnext=<<)$doletmatching=filter(T.isPrefixOfn.fst)forM_(matchingnew)$\(n',v)->mapM_(notifypn'(Justv))actsforM_(matchingchangedOrGone)$\(n',v)->mapM_(notifypn'v)acts-- | A completely empty configuration.empty::Configempty=Config""$unsafePerformIO$dop<-newIORef[]m<-newIORefH.emptys<-newIORefH.emptyreturnBaseConfig{cfgAuto=Nothing,cfgPaths=p,cfgMap=m,cfgSubs=s}{-# NOINLINE empty #-}-- $format---- A configuration file consists of a series of directives and-- comments, encoded in UTF-8. A comment begins with a \"@#@\"-- character, and continues to the end of a line.---- Files and directives are processed from first to last, top to-- bottom.-- $binding---- A binding associates a name with a value.---- > my_string = "hi mom! \u2603"-- > your-int-33 = 33-- > his_bool = on-- > HerList = [1, "foo", off]---- A name must begin with a Unicode letter, which is followed by zero-- or more of a Unicode alphanumeric code point, hyphen \"@-@\", or-- underscore \"@_@\".---- Bindings are created or overwritten in the order in which they are-- encountered. It is legitimate for a name to be bound multiple-- times, in which case the last value wins.---- > a = 1-- > a = true-- > # value of a is now true, not 1-- $types---- The configuration file format supports the following data types:---- * Booleans, represented as @on@ or @off@, @true@ or @false@. These-- are case sensitive, so do not try to use @True@ instead of-- @true@!---- * Integers, represented in base 10.---- * Unicode strings, represented as text (possibly containing escape-- sequences) surrounded by double quotes.---- * Heterogeneous lists of values, represented as an opening square-- bracket \"@[@\", followed by a series of comma-separated values,-- ending with a closing square bracket \"@]@\".---- The following escape sequences are recognised in a text string:---- * @\\n@ - newline---- * @\\r@ - carriage return---- * @\\t@ - horizontal tab---- * @\\\\@ - backslash---- * @\\\"@ - double quote---- * @\\u@/xxxx/ - Unicode character from the basic multilingual-- plane, encoded as four hexadecimal digits---- * @\\u@/xxxx/@\\u@/xxxx/ - Unicode character from an astral plane,-- as two hexadecimal-encoded UTF-16 surrogates-- $interp---- Strings support interpolation, so that you can dynamically-- construct a string based on data in your configuration or the OS-- environment.---- If a string value contains the special sequence \"@$(foo)@\" (for-- any name @foo@), then the name @foo@ will be looked up in the-- configuration data and its value substituted. If that name cannot-- be found, it will be looked up in the OS environment.---- For security reasons, it is an error for a string interpolation-- fragment to contain a name that cannot be found in either the-- current configuration or the environment.---- To represent a single literal \"@$@\" character in a string, double-- it: \"@$$@\".-- $group---- It is possible to group a number of directives together under a-- single prefix:---- > my-group-- > {-- > a = 1-- >-- > # groups support nesting-- > nested {-- > b = "yay!"-- > }-- > }---- The name of a group is used as a prefix for the items in the-- group. For instance, the value of \"@a@\" above can be retrieved-- using 'lookup' by supplying the name \"@my-group.a@\", and \"@b@\"-- will be named \"@my-group.nested.b@\".-- $import---- To import the contents of another configuration file, use the-- @import@ directive.---- > import "$(HOME)/etc/myapp.cfg"---- Absolute paths are imported as is. Relative paths are resolved with-- respect to the file they are imported from. It is an error for an-- @import@ directive to name a file that does not exist, cannot be read,-- or contains errors.---- If an @import@ appears inside a group, the group's naming prefix-- will be applied to all of the names imported from the given-- configuration file.---- Supposing we have a file named \"@foo.cfg@\":---- > bar = 1---- And another file that imports it into a group:---- > hi {-- > import "foo.cfg"-- > }---- This will result in a value named \"@hi.bar@\".-- $notify---- To more efficiently support an application's need to dynamically-- reconfigure, a subsystem may ask to be notified when a-- configuration property is changed as a result of a reload, using-- the 'subscribe' action.