gdritter repos config-ini / b729a0b
Rename Ini to RawIni; introduce Ini type in Bidir Getty Ritter 7 years ago
6 changed file(s) with 287 addition(s) and 151 deletion(s). Collapse all Expand all
2929 , _confPath = ["/bin"]
3030 }
3131
32 configSpec :: IniSpec Config ()
33 configSpec = section "NETWORK" $ do
34 confUsername .= field "user" text
35 & comment [ "your username" ]
36 confPort .= field "port" number
37 & comment [ "the port in question" ]
38 confUseEncryption .= flag "encryption"
39 & skipIfMissing
40 & comment [ "whether to use encryption (defaults to true)" ]
41 confHostname .= field "hostname" text
42 & skipIfMissing
43 & comment [ "hostname to connect to (optional)" ]
44 confConfigFile .=? field "config file" text
45 & placeholderValue "<file path>"
46 confPath .= field "path" (listWithSeparator ":" text)
47 & skipIfMissing
48 & comment [ "a colon-separated path list" ]
32 configSpec :: Ini Config
33 configSpec = ini sampleConfig $ do
34 section "NETWORK" $ do
35 confUsername .= field "user" text
36 & comment [ "your username" ]
37 confPort .= field "port" number
38 & comment [ "the port in question" ]
39 confUseEncryption .= flag "encryption"
40 & skipIfMissing
41 & comment [ "whether to use encryption (defaults to true)" ]
42 confHostname .= field "hostname" text
43 & skipIfMissing
44 & comment [ "hostname to connect to (optional)" ]
45 confConfigFile .=? field "config file" text
46 & placeholderValue "<file path>"
47 section "LOCAL" $ do
48 confPath .= field "path" (listWithSeparator ":" text)
49 & skipIfMissing
50 & comment [ "a colon-separated path list" ]
4951
5052 example :: Text
5153 example = "[NETWORK]\n\
5254 \# this contains a comment\n\
5355 \; and a semicolon comment\n\
5456 \user: gdritter\n\
55 \port: 8888\n\
56 \path= /bin:/usr/bin\n"
57 \port: 8888\n"
5758
5859 main :: IO ()
5960 main = do
60 let s = parseIniFile sampleConfig configSpec example
61 print s
61 let s = parseIni example configSpec
6262 case s of
6363 Left err -> putStrLn err
6464 Right p -> do
65 let v = getIniValue p
66 print v
6567 putStrLn "------------------------"
66 putStr (unpack (emitIniFile sampleConfig configSpec))
68 putStr (unpack (getIniText configSpec))
6769 putStrLn "------------------------"
68 putStrLn "\n"
69 let p' = p { _confPort = 9191
70 let v' = v { _confPort = 9191
7071 , _confHostname = "argl"
71 , _confPath = "/usr/sbin" : _confPath p
72 , _confPath = "/usr/sbin" : _confPath v
7273 }
7374 let pol = defaultUpdatePolicy
7475 { updateGeneratedCommentPolicy =
7677 [ "value added by application" ]
7778 , updateIgnoreExtraneousFields = False
7879 }
79 let up = updateIniFile p' configSpec example pol
80 case up of
81 Left err -> putStrLn err
82 Right up' -> do
83 putStrLn "------------------------"
84 putStr (unpack up')
85 putStrLn "------------------------"
80 let up = getIniText $ updateIni v' $ setIniUpdatePolicy pol p
81 putStrLn "------------------------"
82 putStr (unpack up)
83 putStrLn "------------------------"
44 {-# LANGUAGE ScopedTypeVariables #-}
55 {-# LANGUAGE ExistentialQuantification #-}
66 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
7 {-# LANGUAGE MultiWayIf #-}
78
89 module Data.Ini.Config.Bidir
910 (
1112
1213 -- * Parsing, Serializing, and Updating Files
1314 -- $using
14 parseIniFile
15 , emitIniFile
15 -- parseIniFile
16 emitIniFile
1617 , UpdatePolicy(..)
1718 , UpdateCommentPolicy(..)
1819 , defaultUpdatePolicy
19 , updateIniFile
20 , Ini
21 , ini
22 , parseIni
23 , getIniText
24 , getIniValue
25 , updateIni
26 , setIniUpdatePolicy
27
2028 -- * Bidirectional Parser Types
2129 -- $types
2230 , IniSpec
2331 , SectionSpec
32
2433 -- * Section-Level Parsing
2534 -- $sections
2635 , section
36
2737 -- * Field-Level Parsing
2838 -- $fields
2939 , FieldDescription
3444 , comment
3545 , placeholderValue
3646 , skipIfMissing
47
3748 -- * FieldValues
3849 -- $fieldvalues
3950 , FieldValue(..)
4455 , readable
4556 , listWithSeparator
4657 , pairWithSeparator
58
4759 -- * Miscellaneous Helpers
4860 -- $misc
4961 , (&)
5062 , Lens
63
5164 ) where
5265
5366 import Control.Monad.Trans.State.Strict (State, runState, modify)
6780
6881 import Data.Ini.Config.Raw
6982
70 -- * Utility functions
83 -- * Utility functions + lens stuffs
7184
7285 -- | This is a
7386 -- <https://hackage.haskell.org/package/lens lens>-compatible
7487 -- type alias
7588 type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
89
90 -- These are some inline reimplementations of "lens" operators. We
91 -- need the identity functor to implement 'set':
92 newtype I a = I { fromI :: a }
93 instance Functor I where fmap f (I x) = I (f x)
94
95 set :: Lens s t a b -> b -> s -> t
96 set lns x a = fromI (lns (const (I x)) a)
97
98 -- ... and we need the const functor to implement 'get':
99 newtype C a b = C { fromC :: a }
100 instance Functor (C a) where fmap _ (C x) = C x
101
102 get :: Lens s t a b -> s -> a
103 get lns a = fromC (lns C a)
76104
77105 lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
78106 lkp t = fmap snd . F.find (\ (t', _) -> t' == t)
92120 infixl 1 &
93121 #endif
94122
123 -- * The 'Ini' type
124
125 -- | An 'Ini' is an abstract representation of an INI file, including
126 -- both its textual representation and the Haskell value it
127 -- represents.
128 data Ini s = Ini
129 { iniSpec :: Spec s
130 , iniCurr :: s
131 , iniDef :: s
132 , iniLast :: Maybe RawIni
133 , iniPol :: UpdatePolicy
134 }
135
136 -- | Create a basic 'Ini' value from a default value and a spec.
137 ini :: s -> IniSpec s () -> Ini s
138 ini def (IniSpec spec) = Ini
139 { iniSpec = runBidirM spec
140 , iniCurr = def
141 , iniDef = def
142 , iniLast = Nothing
143 , iniPol = defaultUpdatePolicy
144 }
145
146 -- | Get the underlying Haskell value associated with the 'Ini'.
147 getIniValue :: Ini s -> s
148 getIniValue = iniCurr
149
150 -- | Get the textual representation of an 'Ini' value. If this 'Ini'
151 -- value is the result of 'parseIni', then it will attempt to retain
152 -- the textual characteristics of the parsed version as much as
153 -- possible (e.g. by retaining comments, ordering, and whitespace in a
154 -- way that will minimize the overall diff footprint.) If the 'Ini'
155 -- value was created directly from a value and a specification, then
156 -- it will pretty-print an initial version of the file with the
157 -- comments and placeholder text specified in the spec.
158 getIniText :: Ini s -> Text
159 getIniText = printRawIni . getRawIni
160
161 -- | Get the underlying 'RawIni' value for the file.
162 getRawIni :: Ini s -> RawIni
163 getRawIni (Ini { iniLast = Just raw }) = raw
164 getRawIni (Ini { iniCurr = s
165 , iniSpec = spec
166 }) = emitIniFile s spec
167
168 -- | Parse a textual representation of an 'Ini' file. If the file is
169 -- malformed or if an obligatory field is not found, this will produce
170 -- a human-readable error message. If an optional field is not found,
171 -- then it will fall back on the existing value contained in the
172 -- provided 'Ini' structure.
173 parseIni :: Text -> Ini s -> Either String (Ini s)
174 parseIni t i@Ini { iniSpec = spec
175 , iniCurr = def
176 } = do
177 RawIni raw <- parseRawIni t
178 s <- parseSections def (Seq.viewl spec) raw
179 return $ i
180 { iniCurr = s
181 , iniLast = Just (RawIni raw)
182 }
183
184 -- | Update the internal value of an 'Ini' file. If this 'Ini' value
185 -- is the result of 'parseIni', then the resulting 'Ini' value will
186 -- attempt to retain the textual characteristics of the parsed version
187 -- as much as possible (e.g. by retaining comments, ordering, and
188 -- whitespace in a way that will minimize the overall diff footprint.)
189 updateIni :: s -> Ini s -> Ini s
190 updateIni new i =
191 case doUpdateIni new i of
192 Left err -> error err
193 Right i' -> i'
194
195 setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s
196 setIniUpdatePolicy pol i = i { iniPol = pol }
197
95198 -- * Type definitions
96199
97 -- | A value of type "FieldValue" packages up a parser and emitter
200 -- | A value of type 'FieldValue' packages up a parser and emitter
98201 -- function into a single value. These are used for bidirectional
99202 -- parsing and emitting of the value of a field.
100203 data FieldValue a = FieldValue
103206 -- the parser fails, then the string will be shown as an error
104207 -- message to the user.
105208 , fvEmit :: a -> Text
106 -- ^ The serializer to use when serializing a value into an INI file.
209 -- ^ The function to use when serializing a value into an INI
210 -- file.
107211 }
108212
109213 -- This is actually being used as a writer monad, but using a state
114218
115219 runBidirM :: BidirM s a -> Seq s
116220 runBidirM = snd . flip runState Seq.empty
221
222 type Spec s = Seq (Section s)
117223
118224 -- | An 'IniSpec' value represents the structure of an entire
119225 -- INI-format file in a declarative way. The @s@ parameter represents
129235 newtype SectionSpec s a = SectionSpec (BidirM (Field s) a)
130236 deriving (Functor, Applicative, Monad)
131237
238 -- * Sections
239
132240 -- | Define the specification of a top-level INI section.
133241 section :: Text -> SectionSpec s () -> IniSpec s ()
134242 section name (SectionSpec mote) = IniSpec $ do
141249 isOptional (FieldMb _ fd) = fdSkipIfMissing fd
142250
143251 data Section s = Section NormalizedText (Seq (Field s)) Bool
252
253 -- * Fields
144254
145255 -- | A "Field" is a description of
146256 data Field s
169279 , fdSkipIfMissing :: Bool
170280 }
171281
282 -- ** Field operators
283
172284 {- |
173285 Associate a field description with a field. If this field
174286 is not present when parsing, it will attempt to fall back
192304 (.=?) :: Eq t => Lens s s (Maybe t) (Maybe t) -> FieldDescription t -> SectionSpec s ()
193305 l .=? f = SectionSpec $ modify (Seq.|> fd)
194306 where fd = FieldMb l f
307
308 -- ** Field metadata
195309
196310 {- |
197311 Associate a multiline comment with a "FieldDescription". When
230344 infixr 0 .=
231345 infixr 0 .=?
232346
347 -- ** Creating fields
348
233349 -- | Create a description of a field by a combination of the name of
234350 -- the field and a "FieldValue" describing how to parse and emit
235351 -- values associated with that field.
245361 -- | Create a description of a 'Bool'-valued field.
246362 flag :: Text -> FieldDescription Bool
247363 flag name = field name bool
364
365 -- ** FieldValues
248366
249367 -- | A "FieldValue" for parsing and serializing values according to
250368 -- the logic of the "Read" and "Show" instances for that type,
320438 , fvEmit = \ (x, y) -> fvEmit left x <> sep <> fvEmit right y
321439 }
322440
323 -- | Provided an initial value and an 'IniSpec' describing the
324 -- structure of an INI file, parse a 'Text' value as an INI file,
325 -- update the initial value corresponding to the fields in the INI
326 -- file, and then return the modified value.
327 parseIniFile :: s -> IniSpec s () -> Text -> Either String s
328 parseIniFile def (IniSpec mote) t =
329 let spec = runBidirM mote
330 in case parseIni t of
331 Left err -> Left err
332 Right (Ini ini) -> runSpec def (Seq.viewl spec) ini
441 -- * Parsing INI files
333442
334443 -- Are you reading this source code? It's not even that gross
335444 -- yet. Just you wait. This is just the regular part. 'runSpec' is
336445 -- easy: we walk the spec, and for each section, find the
337446 -- corresponding section in the INI file and call runFields.
338 runSpec :: s -> Seq.ViewL (Section s) -> Seq (NormalizedText, IniSection)
339 -> Either String s
340 runSpec s Seq.EmptyL _ = Right s
341 runSpec s (Section name fs opt Seq.:< rest) ini
342 | Just v <- lkp name ini = do
343 s' <- runFields s (Seq.viewl fs) v
344 runSpec s' (Seq.viewl rest) ini
345 | opt = runSpec s (Seq.viewl rest) ini
447 parseSections
448 :: s
449 -> Seq.ViewL (Section s)
450 -> Seq (NormalizedText, IniSection)
451 -> Either String s
452 parseSections s Seq.EmptyL _ = Right s
453 parseSections s (Section name fs opt Seq.:< rest) i
454 | Just v <- lkp name i = do
455 s' <- parseFields s (Seq.viewl fs) v
456 parseSections s' (Seq.viewl rest) i
457 | opt = parseSections s (Seq.viewl rest) i
346458 | otherwise = Left ("Unable to find section " ++ show name)
347
348 -- These are some inline reimplementations of "lens" operators. We
349 -- need the identity functor to implement 'set':
350 newtype I a = I { fromI :: a }
351 instance Functor I where fmap f (I x) = I (f x)
352
353 set :: Lens s t a b -> b -> s -> t
354 set lns x a = fromI (lns (const (I x)) a)
355
356 -- ... and we need the const functor to implement 'get':
357 newtype C a b = C { fromC :: a }
358 instance Functor (C a) where fmap _ (C x) = C x
359
360 get :: Lens s t a b -> s -> a
361 get lns a = fromC (lns C a)
362459
363460 -- Now that we've got 'set', we can walk the field descriptions and
364461 -- find them. There's some fiddly logic, but the high-level idea is
366463 -- the provided parser and use the provided lens to add it to the
367464 -- value. We have to decide what to do if it's not there, which
368465 -- depends on lens metadata and whether it's an optional field or not.
369 runFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s
370 runFields s Seq.EmptyL _ = Right s
371 runFields s (Field l descr Seq.:< fs) sect
466 parseFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s
467 parseFields s Seq.EmptyL _ = Right s
468 parseFields s (Field l descr Seq.:< fs) sect
372469 | Just v <- lkp (fdName descr) (isVals sect) = do
373470 value <- fvParse (fdValue descr) (T.strip (vValue v))
374 runFields (set l value s) (Seq.viewl fs) sect
471 parseFields (set l value s) (Seq.viewl fs) sect
375472 | fdSkipIfMissing descr =
376 runFields s (Seq.viewl fs) sect
473 parseFields s (Seq.viewl fs) sect
377474 | otherwise = Left ("Unable to find field " ++ show (fdName descr))
378 runFields s (FieldMb l descr Seq.:< fs) sect
475 parseFields s (FieldMb l descr Seq.:< fs) sect
379476 | Just v <- lkp (fdName descr) (isVals sect) = do
380477 value <- fvParse (fdValue descr) (T.strip (vValue v))
381 runFields (set l (Just value) s) (Seq.viewl fs) sect
478 parseFields (set l (Just value) s) (Seq.viewl fs) sect
382479 | otherwise =
383 runFields (set l Nothing s) (Seq.viewl fs) sect
480 parseFields (set l Nothing s) (Seq.viewl fs) sect
384481
385482 -- | Serialize a value as an INI file according to a provided
386483 -- 'IniSpec'.
387 emitIniFile :: s -> IniSpec s () -> Text
388 emitIniFile s (IniSpec mote) =
389 let spec = runBidirM mote in
390 printIni $ Ini $ fmap (\ (Section name fs _) ->
391 (name, toSection s (actualText name) fs)) spec
484 emitIniFile :: s -> Spec s -> RawIni
485 emitIniFile s spec =
486 RawIni $
487 fmap (\ (Section name fs _) ->
488 (name, toSection s (actualText name) fs)) spec
392489
393490 mkComments :: Seq Text -> Seq BlankLine
394491 mkComments comments =
476573 -- file, while newly added fields (for example, fields which have
477574 -- been changed from a default value) will be added to the end of the
478575 -- section in which they appear.
479 updateIniFile :: s -> IniSpec s () -> Text -> UpdatePolicy -> Either String Text
480 updateIniFile s (IniSpec mote) t pol =
481 let spec = runBidirM mote
482 in case parseIni t of
483 Left err -> Left ("Error parsing existing INI file: " ++ err)
484 Right (Ini ini) -> do
485 ini' <- updateIniSections s ini spec pol
486 return (printIni (Ini ini'))
487
488 updateIniSections :: s -> Seq (NormalizedText, IniSection)
489 -> Seq (Section s)
490 -> UpdatePolicy
491 -> Either String (Seq (NormalizedText, IniSection))
492 updateIniSections s sections fields pol = do
576 --doUpdateIni :: s -> s -> Spec s -> RawIni -> UpdatePolicy -> Either String (Ini s)
577 doUpdateIni :: s -> Ini s -> Either String (Ini s)
578 doUpdateIni s i@Ini { iniSpec = spec
579 , iniDef = def
580 , iniPol = pol
581 } = do -- spec (RawIni ini) pol = do
582 let RawIni ini' = getRawIni i
583 res <- updateSections s def ini' spec pol
584 return $ i
585 { iniCurr = s
586 , iniLast = Just (RawIni res)
587 }
588
589 updateSections
590 :: s
591 -> s
592 -> Seq (NormalizedText, IniSection)
593 -> Seq (Section s)
594 -> UpdatePolicy
595 -> Either String (Seq (NormalizedText, IniSection))
596 updateSections s def sections fields pol = do
597 -- First, we process all the sections that actually appear in the
598 -- INI file in order
493599 existingSections <- F.for sections $ \ (name, sec) -> do
494600 let err = (Left ("Unexpected top-level section: " ++ show name))
495601 Section _ spec _ <- maybe err Right
496602 (F.find (\ (Section n _ _) -> n == name) fields)
497 newVals <- updateIniSection s (isVals sec) spec pol
603 newVals <- updateFields s (isVals sec) spec pol
498604 return (name, sec { isVals = newVals })
605 -- And then
499606 let existingSectionNames = fmap fst existingSections
500607 newSections <- F.for fields $
501 \ (Section nm spec isOpt) ->
502 if nm `elem` existingSectionNames
503 then return mempty
504 else return (Seq.singleton (nm, IniSection (actualText nm) mempty 0 0 mempty))
608 \ (Section nm spec _) ->
609 if | nm `elem` existingSectionNames -> return mempty
610 | otherwise ->
611 let rs = emitNewFields s def spec
612 in if Seq.null rs
613 then return mempty
614 else return $ Seq.singleton
615 ( nm
616 , IniSection (actualText nm) rs 0 0 mempty
617 )
505618 return (existingSections <> F.asum newSections)
506619
507 updateIniSection :: s -> Seq (NormalizedText, IniValue) -> Seq (Field s)
620 -- We won't emit a section if everything in the section is also
621 -- missing
622 emitNewFields :: s -> s -> Seq (Field s) -> Seq (NormalizedText, IniValue)
623 emitNewFields s def fields = go (Seq.viewl fields) where
624 go EmptyL = Seq.empty
625 go (Field l d :< fs)
626 -- If a field is not present but is also the same as the default,
627 -- then we can safely omit it
628 | get l s == get l def = go (Seq.viewl fs)
629 -- otherwise, we should add it to the result
630 | otherwise =
631 let new = ( fdName d
632 , IniValue
633 { vLineNo = 0
634 , vName = actualText (fdName d)
635 , vValue = fvEmit (fdValue d) (get l s)
636 , vComments = mempty
637 , vCommentedOut = False
638 , vDelimiter = '='
639 }
640 )
641 in new <| go (Seq.viewl fs)
642 go (FieldMb l d :< fs) =
643 case get l s of
644 Nothing -> go (Seq.viewl fs)
645 Just v ->
646 let new = ( fdName d
647 , IniValue
648 { vLineNo = 0
649 , vName = actualText (fdName d)
650 , vValue = fvEmit (fdValue d) v
651 , vComments = mempty
652 , vCommentedOut = False
653 , vDelimiter = '='
654 }
655 )
656 in new <| go (Seq.viewl fs)
657
658
659 updateFields :: s -> Seq (NormalizedText, IniValue) -> Seq (Field s)
508660 -> UpdatePolicy -> Either String (Seq (NormalizedText, IniValue))
509 updateIniSection s values fields pol = go (Seq.viewl values) fields
661 updateFields s values fields pol = go (Seq.viewl values) fields
510662 where go ((t, val) :< vs) fs =
511663 -- For each field, we need to fetch the description of the
512664 -- field in the spec
565717 -- were left out, but if we have any non-optional fields left
566718 -- over, then we definitely need to include them.
567719 go EmptyL fs = return (finish (Seq.viewl fs))
568 finish (f@(Field l _) :< fs)
720 finish (f@(Field {}) :< fs)
569721 | updateAddOptionalFields pol
570722 , Just val <- mkValue (fieldName f) f '=' =
571723 (fieldName f, val) <| finish (Seq.viewl fs)
604756 Nothing -> Nothing
605757
606758
607 -- DELETE ME LATER
608
609 lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
610 lens gt st f a = (`st` a) `fmap` f (gt a)
611
612 _1 :: Lens (a, b) (a, b) a a
613 _1 = lens fst (\ a (_, b) -> (a, b))
614
615 _2 :: Lens (a, b) (a, b) b b
616 _2 = lens snd (\ b (a, _) -> (a, b))
617
618
619
620759 {- $main
621760
622761 This module presents an alternate API for parsing INI files. Unlike
704843 & 'skipIfMissing'
705844 cfPost '.=' 'field' \"port\" 'number'
706845 & 'comment' [\"The port number\"]
707 & 'defaultValue' 9999
708846 'sectionOpt' \"LOCAL\" $ do
709847 cfUser '.=?' 'field' \"user\" 'text'
710848 @
22 ( -- $main
33
44 -- * INI types
5 Ini(..)
5 RawIni(..)
66 , IniSection(..)
77 , IniValue(..)
88 , BlankLine(..)
99 , NormalizedText(..)
1010 , normalize
1111 -- * serializing and deserializing
12 , parseIni
13 , printIni
12 , parseRawIni
13 , printRawIni
1414 ) where
1515
1616 import Control.Monad (void)
4545 -- 'IniSection' values. The section names in this mapping are
4646 -- normalized to lower-case and stripped of whitespace. This
4747 -- sequence retains the ordering of the original source file.
48 newtype Ini = Ini
49 { fromIni :: Seq (NormalizedText, IniSection)
48 newtype RawIni = RawIni
49 { fromRawIni :: Seq (NormalizedText, IniSection)
5050 } deriving (Eq, Show)
5151
5252 -- | An 'IniSection' consists of a name, a mapping of key-value pairs,
113113
114114 -- | Parse a 'Text' value into an 'Ini' value, retaining a maximal
115115 -- amount of structure as needed to reconstruct the original INI file.
116 parseIni :: Text -> Either String Ini
117 parseIni t = case runParser pIni "ini file" t of
116 parseRawIni :: Text -> Either String RawIni
117 parseRawIni t = case runParser pIni "ini file" t of
118118 Left err -> Left (parseErrorPretty err)
119119 Right v -> Right v
120120
121 pIni :: Parser Ini
121 pIni :: Parser RawIni
122122 pIni = do
123123 leading <- sBlanks
124124 pSections leading Seq.empty
132132 txt <- T.pack `fmap` manyTill anyChar eol
133133 return (CommentLine c txt)
134134
135 pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser Ini
135 pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
136136 pSections leading prevs =
137 pSection leading prevs <|> (Ini prevs <$ void eof)
138
139 pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser Ini
137 pSection leading prevs <|> (RawIni prevs <$ void eof)
138
139 pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
140140 pSection leading prevs = do
141141 start <- getCurrentLine
142142 void (char '[')
152152 -> Seq (NormalizedText, IniSection)
153153 -> Seq BlankLine
154154 -> Seq (NormalizedText, IniValue)
155 -> Parser Ini
155 -> Parser RawIni
156156 pPairs name start leading prevs comments pairs = newPair <|> finishedSection
157157 where
158158 newPair = do
193193 -- | Serialize an INI file to text, complete with any comments which
194194 -- appear in the INI structure, and retaining the aesthetic details
195195 -- which are present in the INI file.
196 printIni :: Ini -> Text
197 printIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromIni
196 printRawIni :: RawIni -> Text
197 printRawIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromRawIni
198198 where
199199 build (_, ini) =
200200 F.foldMap buildComment (isComments ini) <>
6060
6161 -- | An 'IniParser' value represents a computation for parsing entire
6262 -- INI-format files.
63 newtype IniParser a = IniParser (StParser Ini a)
63 newtype IniParser a = IniParser (StParser RawIni a)
6464 deriving (Functor, Applicative, Alternative, Monad)
6565
6666 -- | A 'SectionParser' value represents a computation for parsing a single
7171 -- | Parse a 'Text' value as an INI file and run an 'IniParser' over it
7272 parseIniFile :: Text -> IniParser a -> Either String a
7373 parseIniFile text (IniParser mote) = do
74 ini <- parseIni text
74 ini <- parseRawIni text
7575 runExceptT mote ini
7676
7777 -- | Find a named section in the INI file and parse it with the provided
8484 -- >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x")
8585 -- Left "No top-level section named \"TWO\""
8686 section :: Text -> SectionParser a -> IniParser a
87 section name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
87 section name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
8888 case lkp (normalize name) ini of
8989 Nothing -> Left ("No top-level section named " ++ show name)
9090 Just sec -> runExceptT thunk sec
100100 -- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x")
101101 -- Right Nothing
102102 sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
103 sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
103 sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
104104 case lkp (normalize name) ini of
105105 Nothing -> return Nothing
106106 Just sec -> Just `fmap` runExceptT thunk sec
116116 -- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x")
117117 -- Right "def"
118118 sectionDef :: Text -> a -> SectionParser a -> IniParser a
119 sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
119 sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
120120 case lkp (normalize name) ini of
121121 Nothing -> return def
122122 Just sec -> runExceptT thunk sec
2525 raw <- forAll mkIni
2626 let printed = I1.printIniWith I1.defaultWriteIniSettings raw
2727 i1 = I1.parseIni printed
28 i2 = I2.parseIni printed
28 i2 = I2.parseRawIni printed
2929 case (i1, i2) of
3030 (Right i1', Right i2') ->
3131 let i1'' = lower i1'
3636 propRevIniEquiv :: Property
3737 propRevIniEquiv = property $ do
3838 raw <- forAll mkRichIni
39 let printed = I2.printIni raw
39 let printed = I2.printRawIni raw
4040 i1 = I1.parseIni printed
41 i2 = I2.parseIni printed
41 i2 = I2.parseRawIni printed
4242 case (i1, i2) of
4343 (Right i1', Right i2') ->
4444 lower i1' === toMaps i2'
4747 propIniSelfEquiv :: Property
4848 propIniSelfEquiv = property $ do
4949 raw <- forAll mkRichIni
50 Right (toMaps raw) === fmap toMaps (I2.parseIni (I2.printIni raw))
50 Right (toMaps raw) === fmap toMaps (I2.parseRawIni (I2.printRawIni raw))
5151
5252 lower :: I1.Ini -> HashMap Text (HashMap Text Text)
5353 lower (I1.Ini ini) = go (fmap go ini)
5454 where go hm = HM.fromList [ (T.toLower k, v) | (k, v) <- HM.toList hm ]
5555
56 toMaps :: I2.Ini -> HashMap Text (HashMap Text Text)
57 toMaps (I2.Ini m) = conv (fmap sectionToPair m)
56 toMaps :: I2.RawIni -> HashMap Text (HashMap Text Text)
57 toMaps (I2.RawIni m) = conv (fmap sectionToPair m)
5858 where sectionToPair (name, section) =
5959 (I2.normalizedText name, conv (fmap valueToPair (I2.isVals section)))
6060 valueToPair (name, value) =
8080 , I2.CommentLine <$> Gen.element ";#" <*> textChunk
8181 ]
8282
83 mkRichIni :: Monad m => Gen m I2.Ini
83 mkRichIni :: Monad m => Gen m I2.RawIni
8484 mkRichIni = do
8585 ss <- Gen.list (Range.linear 0 100) $ do
8686 name <- textChunk
9595 return ( I2.normalize name
9696 , I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs
9797 )
98 return (I2.Ini (Seq.fromList (nubBy ((==) `on` fst) ss)))
98 return (I2.RawIni (Seq.fromList (nubBy ((==) `on` fst) ss)))
9999
100100 main :: IO ()
101101 main = do
2222
2323 type IniSeq = Seq (Text, Seq (Text, Text))
2424
25 toMaps :: Ini -> IniSeq
26 toMaps (Ini m) = fmap sectionToPair m
25 toMaps :: RawIni -> IniSeq
26 toMaps (RawIni m) = fmap sectionToPair m
2727 where sectionToPair (name, section) =
2828 (normalizedText name, fmap valueToPair (isVals section))
2929 valueToPair (name, value) =
3434 let hsF = take (length iniF - 4) iniF ++ ".hs"
3535 ini <- T.readFile (dir ++ "/" ++ iniF)
3636 hs <- readFile (dir ++ "/" ++ hsF)
37 case parseIni ini of
37 case parseRawIni ini of
3838 Left err -> do
3939 putStrLn ("Error parsing " ++ iniF)
4040 putStrLn err