gdritter repos config-ini / master src / Data / Ini / Config.hs
master

Tree @master (Download .tar.gz)

Config.hs @masterraw · history · blame

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
{-|
Module     : Data.Ini.Config
Copyright  : (c) Getty Ritter, 2017
License    : BSD
Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
Stability  : experimental

The 'config-ini' library exports some simple monadic functions to
make parsing INI-like configuration easier. INI files have a
two-level structure: the top-level named chunks of configuration,
and the individual key-value pairs contained within those chunks.
For example, the following INI file has two sections, @NETWORK@
and @LOCAL@, and each contains its own key-value pairs. Comments,
which begin with @#@ or @;@, are ignored:

> [NETWORK]
> host = example.com
> port = 7878
>
> # here is a comment
> [LOCAL]
> user = terry

The combinators provided here are designed to write quick and
idiomatic parsers for files of this form. Sections are parsed by
'IniParser' computations, like 'section' and its variations,
while the fields within sections are parsed by 'SectionParser'
computations, like 'field' and its variations. If we want to
parse an INI file like the one above, treating the entire
@LOCAL@ section as optional, we can write it like this:

> data Config = Config
>   { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
>     deriving (Eq, Show)
>
> data NetworkConfig = NetworkConfig
>   { netHost :: String, netPort :: Int }
>     deriving (Eq, Show)
>
> data LocalConfig = LocalConfig
>   { localUser :: Text }
>     deriving (Eq, Show)
>
> configParser :: IniParser Config
> configParser = do
>   netCf <- section "NETWORK" $ do
>     host <- fieldOf "host" string
>     port <- fieldOf "port" number
>     return NetworkConfig { netHost = host, netPort = port }
>   locCf <- sectionMb "LOCAL" $
>     LocalConfig <$> field "user"
>   return Config { cfNetwork = netCf, cfLocal = locCf }


We can run our computation with 'parseIniFile', which,
when run on our example file above, would produce the
following:

>>> parseIniFile example configParser
Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})

-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Ini.Config
(
-- * Parsing Files
  parseIniFile
-- * Parser Types
, IniParser
, SectionParser
-- * Section-Level Parsing
, section
, sections
, sectionOf
, sectionsOf
, sectionMb
, sectionDef
-- * Field-Level Parsing
, field
, fieldOf
, fieldMb
, fieldMbOf
, fieldDef
, fieldDefOf
, fieldFlag
, fieldFlagDef
-- * Reader Functions
, readable
, number
, string
, flag
, listWithSeparator
) where

import           Control.Applicative (Alternative(..))
import           Control.Monad.Trans.Except
import           Data.Ini.Config.Raw
import           Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import           Data.String (IsString(..))
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Typeable (Typeable, Proxy(..), typeRep)
import           GHC.Exts (IsList(..))
import           Text.Read (readMaybe)

lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp t = go . Seq.viewl
  where go ((t', x) Seq.:< rs)
          | t == t'   = Just x
          | otherwise = go (Seq.viewl rs)
        go Seq.EmptyL = Nothing

addLineInformation :: Int -> Text -> StParser s a -> StParser s a
addLineInformation lineNo sec = withExceptT go
  where go e = "Line " ++ show lineNo ++
               ", in section " ++ show sec ++
               ": " ++ e

type StParser s a = ExceptT String ((->) s) a

-- | An 'IniParser' value represents a computation for parsing entire
--   INI-format files.
newtype IniParser a = IniParser (StParser RawIni a)
  deriving (Functor, Applicative, Alternative, Monad)

-- | A 'SectionParser' value represents a computation for parsing a single
--   section of an INI-format file.
newtype SectionParser a = SectionParser (StParser IniSection a)
  deriving (Functor, Applicative, Alternative, Monad)

-- | Parse a 'Text' value as an INI file and run an 'IniParser' over it
parseIniFile :: Text -> IniParser a -> Either String a
parseIniFile text (IniParser mote) = do
  ini <- parseRawIni text
  runExceptT mote ini

-- | Find a named section in the INI file and parse it with the provided
--   section parser, failing if the section does not exist. In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ section "ONE" (field "x")
--   Right "hello"
--   >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x")
--   Left "No top-level section named \"TWO\""
section :: Text -> SectionParser a -> IniParser a
section name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
  case lkp (normalize name) ini of
    Nothing  -> Left ("No top-level section named " ++ show name)
    Just sec -> runExceptT thunk sec

-- | Find multiple named sections in the INI file and parse them all
--   with the provided section parser. In order to support classic INI
--   files with capitalized section names, section lookup is
--   __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n[ONE]\nx = goodbye\n" $ sections "ONE" (field "x")
--   Right (fromList ["hello","goodbye"])
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sections "TWO" (field "x")
--   Right (fromList [])
sections :: Text -> SectionParser a -> IniParser (Seq a)
sections name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
  let name' = normalize name
  in mapM (runExceptT thunk . snd)
          (Seq.filter (\ (t, _) -> t == name') ini)

-- | A call to @sectionOf f@ will apply @f@ to each section name and,
--   if @f@ produces a "Just" value, pass the extracted value in order
--   to get the "SectionParser" to use for that section. This will
--   find at most one section, and will produce an error if no section
--   exists.
--
--   >>> parseIniFile "[FOO]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right ("F","hello")
--   >>> parseIniFile "[BAR]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Left "No matching top-level section"
sectionOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser a
sectionOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) ->
  let go Seq.EmptyL = Left "No matching top-level section"
      go ((t, sec) Seq.:< rs)
        | Just v <- fn (actualText t) =
            let SectionParser thunk = sectionParser v
            in runExceptT thunk sec
        | otherwise = go (Seq.viewl rs)
  in go (Seq.viewl ini)


-- | A call to @sectionsOf f@ will apply @f@ to each section name and,
--   if @f@ produces a @Just@ value, pass the extracted value in order
--   to get the "SectionParser" to use for that section. This will
--   return every section for which the call to @f@ produces a "Just"
--   value.
--
--   >>> parseIniFile "[FOO]\nx = hello\n[BOO]\nx = goodbye\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right (fromList [("F","hello"),("B","goodbye")])
--   >>> parseIniFile "[BAR]\nx = hello\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right (fromList [])
sectionsOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser (Seq a)
sectionsOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) ->
  let go Seq.EmptyL = return Seq.empty
      go ((t, sec) Seq.:< rs)
        | Just v <- fn (actualText t) =
            let SectionParser thunk = sectionParser v
            in do
              x <- runExceptT thunk sec
              xs <- go (Seq.viewl rs)
              return (x Seq.<| xs)
        | otherwise = go (Seq.viewl rs)
  in go (Seq.viewl ini)

-- | Find a named section in the INI file and parse it with the provided
--   section parser, returning 'Nothing' if the section does not exist.
--   In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "ONE" (field "x")
--   Right (Just "hello")
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x")
--   Right Nothing
sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
  case lkp (normalize name) ini of
    Nothing  -> return Nothing
    Just sec -> Just `fmap` runExceptT thunk sec

-- | Find a named section in the INI file and parse it with the provided
--   section parser, returning a default value if the section does not exist.
--   In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "ONE" "def" (field "x")
--   Right "hello"
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x")
--   Right "def"
sectionDef :: Text -> a -> SectionParser a -> IniParser a
sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
  case lkp (normalize name) ini of
    Nothing  -> return def
    Just sec -> runExceptT thunk sec

---

throw :: String -> StParser s a
throw msg = ExceptT $ (\ _ -> Left msg)

getSectionName :: StParser IniSection Text
getSectionName = ExceptT $ (\ m -> return (isName m))

rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
rawFieldMb name = ExceptT $ \m ->
  return (lkp (normalize name) (isVals m))

rawField :: Text -> StParser IniSection IniValue
rawField name = do
  sec   <- getSectionName
  valMb <- rawFieldMb name
  case valMb of
    Nothing -> throw ("Missing field " ++ show name ++
                      " in section " ++ show sec)
    Just x  -> return x

getVal :: IniValue -> Text
getVal = T.strip . vValue

-- | Retrieve a field, failing if it doesn't exist, and return its raw value.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "x")
--   Right "hello"
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "y")
--   Left "Missing field \"y\" in section \"MAIN\""
field :: Text -> SectionParser Text
field name = SectionParser $ getVal `fmap` rawField name

-- | Retrieve a field and use the supplied parser to parse it as a value,
--   failing if the field does not exist, or if the parser fails to
--   produce a value.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "x" number)
--   Right 72
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldOf "x" number)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "y" number)
--   Left "Missing field \"y\" in section \"MAIN\""
fieldOf :: Text -> (Text -> Either String a) -> SectionParser a
fieldOf name parse = SectionParser $ do
  sec <- getSectionName
  val <- rawField name
  case parse (getVal val) of
    Left err -> addLineInformation (vLineNo val) sec (throw err)
    Right x  -> return x

-- | Retrieve a field, returning a @Nothing@ value if it does not exist.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "x")
--   Right (Just "hello")
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "y")
--   Right Nothing
fieldMb :: Text -> SectionParser (Maybe Text)
fieldMb name = SectionParser $ fmap getVal `fmap` rawFieldMb name

-- | Retrieve a field and parse it according to the given parser, returning
--   @Nothing@ if it does not exist. If the parser fails, then this will
--   fail.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "x" number)
--   Right (Just 72)
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMbOf "x" number)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "y" number)
--   Right Nothing
fieldMbOf :: Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf name parse = SectionParser $ do
  sec <- getSectionName
  mb <- rawFieldMb name
  case mb of
    Nothing  -> return Nothing
    Just v -> case parse (getVal v) of
      Left err -> addLineInformation (vLineNo v) sec (throw err)
      Right x  -> return (Just x)

-- | Retrieve a field and supply a default value for if it doesn't exist.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "x" "def")
--   Right "hello"
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "y" "def")
--   Right "def"
fieldDef :: Text -> Text -> SectionParser Text
fieldDef name def = SectionParser $ ExceptT $ \m ->
  case lkp (normalize name) (isVals m) of
    Nothing -> return def
    Just x  -> return (getVal x)

-- | Retrieve a field, parsing it according to the given parser, and returning
--   a default value if it does not exist. If the parser fails, then this will
--   fail.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "x" number 99)
--   Right 72
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDefOf "x" number 99)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "y" number 99)
--   Right 99
fieldDefOf :: Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf name parse def = SectionParser $ do
  sec <- getSectionName
  mb <- rawFieldMb name
  case mb of
    Nothing  -> return def
    Just v -> case parse (getVal v) of
      Left err -> addLineInformation (vLineNo v) sec (throw err)
      Right x  -> return x

-- | Retrieve a field and treat it as a boolean, failing if it
--   does not exist.
--
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "x")
--   Right True
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "y")
--   Left "Missing field \"y\" in section \"MAIN\""
fieldFlag :: Text -> SectionParser Bool
fieldFlag name = fieldOf name flag

-- | Retrieve a field and treat it as a boolean, subsituting
--   a default value if it doesn't exist.
--
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "x" False)
--   Right True
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldFlagDef "x" False)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "y" False)
--   Right False
fieldFlagDef :: Text -> Bool -> SectionParser Bool
fieldFlagDef name def = fieldDefOf name flag def

---

-- | Try to use the "Read" instance for a type to parse a value, failing
--   with a human-readable error message if reading fails.
--
--   >>> readable "(5, 7)" :: Either String (Int, Int)
--   Right (5,7)
--   >>> readable "hello" :: Either String (Int, Int)
--   Left "Unable to parse \"hello\" as a value of type (Int,Int)"
readable :: forall a. (Read a, Typeable a) => Text -> Either String a
readable t = case readMaybe str of
  Just v  -> Right v
  Nothing -> Left ("Unable to parse " ++ show str ++
                   " as a value of type " ++ show typ)
  where str = T.unpack t
        typ = typeRep prx
        prx :: Proxy a
        prx = Proxy

-- | Try to use the "Read" instance for a numeric type to parse a value,
--   failing with a human-readable error message if reading fails.
--
--   >>> number "5" :: Either String Int
--   Right 5
--   >>> number "hello" :: Either String Int
--   Left "Unable to parse \"hello\" as a value of type Int"
number :: (Num a, Read a, Typeable a) => Text -> Either String a
number = readable

-- | Convert a textual value to the appropriate string type. This will
--   never fail.
--
--   >>> string "foo" :: Either String String
--   Right "foo"
string :: (IsString a) => Text -> Either String a
string = return . fromString . T.unpack

-- | Convert a string that represents a boolean to a proper boolean. This
--   is case-insensitive, and matches the words @true@, @false@, @yes@,
--   @no@, as well as single-letter abbreviations for all of the above.
--   If the input does not match, then this will fail with a human-readable
--   error message.
--
--   >>> flag "TRUE"
--   Right True
--   >>> flag "y"
--   Right True
--   >>> flag "no"
--   Right False
--   >>> flag "F"
--   Right False
--   >>> flag "That's a secret!"
--   Left "Unable to parse \"That's a secret!\" as a boolean"
flag :: Text -> Either String Bool
flag s = case T.toLower s of
  "true"  -> Right True
  "yes"   -> Right True
  "t"     -> Right True
  "y"     -> Right True
  "false" -> Right False
  "no"    -> Right False
  "f"     -> Right False
  "n"     -> Right False
  _       -> Left ("Unable to parse " ++ show s ++ " as a boolean")

-- | Convert a reader for a value into a reader for a list of those
--   values, separated by a chosen separator. This will split apart
--   the string on that separator, get rid of leading and trailing
--   whitespace on the individual chunks, and then attempt to parse
--   each of them according to the function provided, turning the
--   result into a list.
--
--   This is overloaded with the "IsList" typeclass, so it can be
--   used transparently to parse other list-like types.
--
--   >>> listWithSeparator "," number "2, 3, 4" :: Either String [Int]
--   Right [2,3,4]
--   >>> listWithSeparator " " number "7 8 9" :: Either String [Int]
--   Right [7,8,9]
--   >>> listWithSeparator ":" string "/bin:/usr/bin" :: Either String [FilePath]
--   Right ["/bin","/usr/bin"]
--   >>> listWithSeparator "," number "7 8 9" :: Either String [Int]
--   Left "Unable to parse \"7 8 9\" as a value of type Int"
listWithSeparator :: (IsList l)
                  => Text
                  -> (Text -> Either String (Item l))
                  -> Text -> Either String l
listWithSeparator sep rd =
  fmap fromList . mapM (rd . T.strip) . T.splitOn sep

-- $setup
--
-- >>> :{
-- data NetworkConfig = NetworkConfig
--    { netHost :: String, netPort :: Int }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- data LocalConfig = LocalConfig
--   { localUser :: Text }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- data Config = Config
--   { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- let configParser = do
--       netCf <- section "NETWORK" $ do
--         host <- fieldOf "host" string
--         port <- fieldOf "port" number
--         return NetworkConfig { netHost = host, netPort = port }
--       locCf <- sectionMb "LOCAL" $
--         LocalConfig <$> field "user"
--       return Config { cfNetwork = netCf, cfLocal = locCf }
-- >>> :}
--
-- >>> :{
--    let example = "[NETWORK]\nhost = example.com\nport = 7878\n\n# here is a comment\n[LOCAL]\nuser = terry\n"
-- >>> :}