gdritter repos config-ini / 12adbbe
Introduce NormalizedText alias for lower-casing and elimination of spaces Getty Ritter 6 years ago
5 changed file(s) with 65 addition(s) and 47 deletion(s). Collapse all Expand all
+22
-25
src/Data/Ini/Config/Bidir.hs less more
7474 -- type alias
7575 type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
7676
77 lkp :: Text -> Seq (Text, a) -> Maybe a
78 lkp t = go . Seq.viewl
79 where go ((t', x) Seq.:< rs)
80 | T.toLower t == T.toLower t' = Just x
81 | otherwise = go (Seq.viewl rs)
82 go Seq.EmptyL = Nothing
83
84 rmv :: Text -> Seq (Field s) -> Seq (Field s)
85 rmv n = Seq.filter (\ f -> T.toLower (fieldName f) /= T.toLower n)
77 lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
78 lkp t = fmap snd . F.find (\ (t', _) -> t' == t)
79
80 rmv :: NormalizedText -> Seq (Field s) -> Seq (Field s)
81 rmv n = Seq.filter (\ f -> fieldName f /= n)
8682
8783 -- The & operator is really useful here, but it didn't show up in
8884 -- earlier versions, so it gets redefined here.
137133 section :: Text -> SectionSpec s () -> IniSpec s ()
138134 section name (SectionSpec mote) = IniSpec $ do
139135 let fields = runBidirM mote
140 modify (Seq.|> Section name fields (allOptional fields))
136 modify (Seq.|> Section (normalize name) fields (allOptional fields))
141137
142138 allOptional :: (Seq (Field s)) -> Bool
143139 allOptional = all isOptional
144140 where isOptional (Field _ fd) = fdSkipIfMissing fd
145141 isOptional (FieldMb _ fd) = fdSkipIfMissing fd
146142
147 data Section s = Section Text (Seq (Field s)) Bool
143 data Section s = Section NormalizedText (Seq (Field s)) Bool
148144
149145 -- | A "Field" is a description of
150146 data Field s
152148 | forall a. Eq a => FieldMb (Lens s s (Maybe a) (Maybe a)) (FieldDescription a)
153149
154150 -- convenience accessors for things in a Field
155 fieldName :: Field s -> Text
151 fieldName :: Field s -> NormalizedText
156152 fieldName (Field _ FieldDescription { fdName = n }) = n
157153 fieldName (FieldMb _ FieldDescription { fdName = n }) = n
158154
166162 -- well as other metadata that might be needed in the course of
167163 -- parsing or serializing a structure.
168164 data FieldDescription t = FieldDescription
169 { fdName :: Text
165 { fdName :: NormalizedText
170166 , fdValue :: FieldValue t
171167 , fdComment :: Seq Text
172168 , fdDummy :: Maybe Text
239235 -- values associated with that field.
240236 field :: Text -> FieldValue a -> FieldDescription a
241237 field name value = FieldDescription
242 { fdName = name
238 { fdName = normalize name
243239 , fdValue = value
244240 , fdComment = Seq.empty
245241 , fdDummy = Nothing
339335 -- yet. Just you wait. This is just the regular part. 'runSpec' is
340336 -- easy: we walk the spec, and for each section, find the
341337 -- corresponding section in the INI file and call runFields.
342 runSpec :: s -> Seq.ViewL (Section s) -> Seq (Text, IniSection)
338 runSpec :: s -> Seq.ViewL (Section s) -> Seq (NormalizedText, IniSection)
343339 -> Either String s
344340 runSpec s Seq.EmptyL _ = Right s
345341 runSpec s (Section name fs opt Seq.:< rest) ini
346 | Just v <- lkp (T.toLower name) ini = do
342 | Just v <- lkp name ini = do
347343 s' <- runFields s (Seq.viewl fs) v
348344 runSpec s' (Seq.viewl rest) ini
349345 | opt = runSpec s (Seq.viewl rest) ini
391387 emitIniFile :: s -> IniSpec s () -> Text
392388 emitIniFile s (IniSpec mote) =
393389 let spec = runBidirM mote in
394 printIni $ Ini $ fmap (\ (Section name fs _) -> (name, toSection s name fs)) spec
390 printIni $ Ini $ fmap (\ (Section name fs _) ->
391 (name, toSection s (actualText name) fs)) spec
395392
396393 mkComments :: Seq Text -> Seq BlankLine
397394 mkComments comments =
408405 ( fdName descr
409406 , IniValue
410407 { vLineNo = 0
411 , vName = fdName descr
408 , vName = actualText (fdName descr)
412409 , vValue = val
413410 , vComments = mkComments (fdComment descr)
414411 , vCommentedOut = optional
488485 ini' <- updateIniSections s ini spec pol
489486 return (printIni (Ini ini'))
490487
491 updateIniSections :: s -> Seq (Text, IniSection)
488 updateIniSections :: s -> Seq (NormalizedText, IniSection)
492489 -> Seq (Section s)
493490 -> UpdatePolicy
494 -> Either String (Seq (Text, IniSection))
491 -> Either String (Seq (NormalizedText, IniSection))
495492 updateIniSections s sections fields pol = do
496493 existingSections <- F.for sections $ \ (name, sec) -> do
497494 let err = (Left ("Unexpected top-level section: " ++ show name))
498495 Section _ spec _ <- maybe err Right
499 (F.find (\ (Section n _ _) -> T.toLower n == name) fields)
496 (F.find (\ (Section n _ _) -> n == name) fields)
500497 newVals <- updateIniSection s (isVals sec) spec pol
501498 return (name, sec { isVals = newVals })
502499 let existingSectionNames = fmap fst existingSections
504501 \ (Section nm spec isOpt) ->
505502 if nm `elem` existingSectionNames
506503 then return mempty
507 else return mempty
504 else return (Seq.singleton (nm, IniSection (actualText nm) mempty 0 0 mempty))
508505 return (existingSections <> F.asum newSections)
509506
510 updateIniSection :: s -> Seq (Text, IniValue) -> Seq (Field s)
511 -> UpdatePolicy -> Either String (Seq (Text, IniValue))
507 updateIniSection :: s -> Seq (NormalizedText, IniValue) -> Seq (Field s)
508 -> UpdatePolicy -> Either String (Seq (NormalizedText, IniValue))
512509 updateIniSection s values fields pol = go (Seq.viewl values) fields
513510 where go ((t, val) :< vs) fs =
514511 -- For each field, we need to fetch the description of the
592589 mkComments cs
593590 val = IniValue
594591 { vLineNo = 0
595 , vName = t <> " "
592 , vName = actualText t <> " "
596593 , vValue = ""
597594 , vComments = comments
598595 , vCommentedOut = False
+28
-10
src/Data/Ini/Config/Raw.hs less more
66 , IniSection(..)
77 , IniValue(..)
88 , BlankLine(..)
9 , NormalizedText(..)
10 , normalize
911 -- * serializing and deserializing
1012 , parseIni
1113 , printIni
2325 import Text.Megaparsec
2426 import Text.Megaparsec.Text
2527
28 data NormalizedText = NormalizedText
29 { actualText :: Text
30 , normalizedText :: Text
31 } deriving (Show)
32
33 normalize :: Text -> NormalizedText
34 normalize t = NormalizedText t (T.toLower (T.strip t))
35
36 instance Eq NormalizedText where
37 NormalizedText _ x == NormalizedText _ y =
38 x == y
39
40 instance Ord NormalizedText where
41 NormalizedText _ x `compare` NormalizedText _ y =
42 x `compare` y
43
2644 -- | An 'Ini' value is a mapping from section names to
2745 -- 'IniSection' values. The section names in this mapping are
2846 -- normalized to lower-case and stripped of whitespace. This
2947 -- sequence retains the ordering of the original source file.
3048 newtype Ini = Ini
31 { fromIni :: Seq (Text, IniSection)
49 { fromIni :: Seq (NormalizedText, IniSection)
3250 } deriving (Eq, Show)
3351
3452 -- | An 'IniSection' consists of a name, a mapping of key-value pairs,
4058 { isName :: Text
4159 -- ^ The name of the section, as it appears in the
4260 -- original INI source
43 , isVals :: Seq (Text, IniValue)
61 , isVals :: Seq (NormalizedText, IniValue)
4462 -- ^ The key-value mapping within that section. Key
4563 -- names here are normalized to lower-case and
4664 -- stripped of whitespace. This sequence retains
114132 txt <- T.pack `fmap` manyTill anyChar eol
115133 return (CommentLine c txt)
116134
117 pSections :: Seq BlankLine -> Seq (Text, IniSection) -> Parser Ini
135 pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser Ini
118136 pSections leading prevs =
119137 pSection leading prevs <|> (Ini prevs <$ void eof)
120138
121 pSection :: Seq BlankLine -> Seq (Text, IniSection) -> Parser Ini
139 pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser Ini
122140 pSection leading prevs = do
123141 start <- getCurrentLine
124142 void (char '[')
131149 pPairs :: Text
132150 -> Int
133151 -> Seq BlankLine
134 -> Seq (Text, IniSection)
152 -> Seq (NormalizedText, IniSection)
135153 -> Seq BlankLine
136 -> Seq (Text, IniValue)
154 -> Seq (NormalizedText, IniValue)
137155 -> Parser Ini
138156 pPairs name start leading prevs comments pairs = newPair <|> finishedSection
139157 where
150168 , isEndLine = end
151169 , isComments = leading
152170 }
153 pSections comments (prevs Seq.|> (T.toLower name, newSection))
154
155 pPair :: Seq BlankLine -> Parser (Text, IniValue)
171 pSections comments (prevs Seq.|> (normalize name, newSection))
172
173 pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)
156174 pPair leading = do
157175 pos <- getCurrentLine
158176 key <- T.pack `fmap` some (noneOf "[]=:")
159177 delim <- oneOf ":="
160178 val <- T.pack `fmap` manyTill anyChar eol
161 return ( T.strip key
179 return ( normalize key
162180 , IniValue
163181 { vLineNo = pos
164182 , vName = key
+6
-6
src/Data/Ini/Config.hs less more
4343 import GHC.Exts (IsList(..))
4444 import Text.Read (readMaybe)
4545
46 lkp :: Text -> Seq (Text, a) -> Maybe a
46 lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
4747 lkp t = go . Seq.viewl
4848 where go ((t', x) Seq.:< rs)
4949 | t == t' = Just x
8585 -- Left "No top-level section named \"TWO\""
8686 section :: Text -> SectionParser a -> IniParser a
8787 section name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
88 case lkp (T.toLower name) ini of
88 case lkp (normalize name) ini of
8989 Nothing -> Left ("No top-level section named " ++ show name)
9090 Just sec -> runExceptT thunk sec
9191
101101 -- Right Nothing
102102 sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
103103 sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
104 case lkp (T.toLower name) ini of
104 case lkp (normalize name) ini of
105105 Nothing -> return Nothing
106106 Just sec -> Just `fmap` runExceptT thunk sec
107107
117117 -- Right "def"
118118 sectionDef :: Text -> a -> SectionParser a -> IniParser a
119119 sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
120 case lkp (T.toLower name) ini of
120 case lkp (normalize name) ini of
121121 Nothing -> return def
122122 Just sec -> runExceptT thunk sec
123123
131131
132132 rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
133133 rawFieldMb name = ExceptT $ \m ->
134 return (lkp name (isVals m))
134 return (lkp (normalize name) (isVals m))
135135
136136 rawField :: Text -> StParser IniSection IniValue
137137 rawField name = do
206206 -- Right "def"
207207 fieldDef :: Text -> Text -> SectionParser Text
208208 fieldDef name def = SectionParser $ ExceptT $ \m ->
209 case lkp name (isVals m) of
209 case lkp (normalize name) (isVals m) of
210210 Nothing -> return def
211211 Just x -> return (vValue x)
212212
+5
-4
test/ini-compat/Main.hs less more
5656 toMaps :: I2.Ini -> HashMap Text (HashMap Text Text)
5757 toMaps (I2.Ini m) = conv (fmap sectionToPair m)
5858 where sectionToPair (name, section) =
59 (name, conv (fmap valueToPair (I2.isVals section)))
60 valueToPair (name, value) = (T.toLower name, T.strip (I2.vValue value))
59 (I2.normalizedText name, conv (fmap valueToPair (I2.isVals section)))
60 valueToPair (name, value) =
61 (I2.normalizedText name, T.strip (I2.vValue value))
6162 conv = HM.fromList . Fold.toList
6263
6364 textChunk :: Monad m => Gen m Text
8788 k <- textChunk
8889 v <- textChunk
8990 cs <- mkComments
90 return ( T.toLower k
91 return ( I2.normalize k
9192 , I2.IniValue 0 k v cs False '='
9293 )
9394 cs <- mkComments
94 return ( T.toLower name
95 return ( I2.normalize name
9596 , I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs
9697 )
9798 return (I2.Ini (Seq.fromList (nubBy ((==) `on` fst) ss)))
+4
-2
test/prewritten/Main.hs less more
2424
2525 toMaps :: Ini -> IniSeq
2626 toMaps (Ini m) = fmap sectionToPair m
27 where sectionToPair (name, section) = (name, fmap valueToPair (isVals section))
28 valueToPair (name, value) = (name, T.strip (vValue value))
27 where sectionToPair (name, section) =
28 (normalizedText name, fmap valueToPair (isVals section))
29 valueToPair (name, value) =
30 (normalizedText name, T.strip (vValue value))
2931
3032 runTest :: FilePath -> IO ()
3133 runTest iniF = do