Commit 321ce84c0a0b61d5c7f0f380e9212f3bf4953275 - config-ini

Reworked Lens parsers to be less overwhelming Lensy; added README docs Getty Ritter 8 years ago

6 changed file(s) with 450 addition(s) and 346 deletion(s). Collapse all Expand all

+70

-0

README.md less more

53	53	Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})
54	54	~~~
55	55
	56	## Setter- and Lens-Based Usage
	57
	58	The above example had an INI file split into two sections (`NETWORK` and `LOCAL`) and a data type with a corresponding structure (containing a `NetworkConfig` and `Maybe LocalConfig` field), which allowed each `section`-level parser to construct a chunk of the configuration and then combine them. This works well if our configuration file has the same structure as our data type, but that might not be what we want. Let's imagine we want to construct our `Config` type as a flat record like this:
	59
	60	~~~.haskell
	61	data Config = Config
	62	{ _cfHost :: String
	63	, _cfPort :: Int
	64	, _cfUser :: Maybe Text
	65	} deriving (Eq, Show)
	66	~~~
	67
	68	In this case, we can't construct a `Config` value until we've parsed all three fields in two distinct subsections. One way of doing this is to return the intermediate values from our `section` parsers and construct the value at the end:
	69
	70	~~~.haskell
	71	configParser :: IniParser Config
	72	configParser = do
	73	(host, port) <- section "NETWORK" $ do
	74	h <- fieldOf "host" string
	75	p <- fieldOf "port" number
	76	return (h, p)
	77	user <- section "LOCAL" $ fieldMb "user"
	78	return (Config host port user)
	79	~~~
	80
	81	This is awkward and repetitive. We could flatten it out by using the same `section` parser multiple times, but this has its own problems, such as unnecessary repetition of the `"NETWORK"` string literal, unnecessarily repetitive table lookups, and general verbosity:
	82
	83	~~~.haskell
	84	configParser :: IniParser Config
	85	configParser = do
	86	host <- section "NETWORK" $ fieldOf "host" string
	87	port <- section "NETWORK" $ fieldOf "port" number
	88	user <- section "LOCAL" $ fieldMb "user"
	89	return (Config host port user)
	90	~~~
	91
	92	One way of resolving this is to use the `Data.Ini.Config.St` module, which provides a slightly different abstraction: the functions exported by this module assume that you start with a default configuration and each field acts as an update on that underlying value. The monads in this module have an extra type parameter that represents the value being modified. The easiest way to use this is with lenses and the `.=` and `.=?` operators, which take a lens and a normal `SectionParser` value, and produce a `SectionStParser` value that uses the lens to update the underlying type:
	93
	94	~~~.haskell
	95	makeLenses ''Config
	96
	97	configParser :: IniStParser Config ()
	98	configParser = do
	99	sectionSt "NETWORK" $ do
	100	cfHost .= fieldOf "host" string
	101	cfPort .= fieldOf "port" number
	102	sectionSt "LOCAL" $ do
	103	cfUser .= fieldMb "user"
	104	~~~
	105
	106	In order to use this parser, we will need to provide an existing value of `Config` so we can apply our updates to it. This is a downside to this approach: in this case, even though the `host` and `port` fields are obligatory, we need to provide dummy values for them.
	107
	108	~~~.haskell
	109	myParseIni :: Text -> Either String Config
	110	myParseIni t = parseIniFileSt t defaultConfig configParser
	111	where defaultConfig = Config "unset" 0 Nothing
	112	~~~
	113
	114	The implementation isn't tied to lenses, and many of the functions exported by `Data.Ini.Config.St` expected any generic setter, and not a lens specifically. If we didn't want to use lenses specifically, we can still take advantage of this library in a more verbose way:
	115
	116	~~~.haskell
	117	configParser :: IniStParser Config ()
	118	configParser = do
	119	sectionSt "NETWORK" $ do
	120	fieldOfSt "host" string (\ h s -> s { _cfHost = h })
	121	fieldOfSt "port" number (\ p s -> s { _cfPort = p })
	122	sectionSt "LOCAL" $ do
	123	fieldMbSt "user" (\ u s -> s { _cfUser = u })
	124	~~~
	125
56	126	## Combinators and Conventions
57	127
58	128	There are several variations on the same basic functionality that appear in `config-ini`. All functions that start with `section` are for parsing section-level chunks of an INI file, while all functions that start with `field` are for parsing key-value pairs within a section. Because it's reasonably common, there are also special `fieldFlag` functions which return `Bool` values, parsed in a relatively loose way.

-1

config-ini.cabal less more

34	34	library
35	35	hs-source-dirs: src
36	36	exposed-modules: Data.Ini.Config
37		, Data.Ini.Config.Lens
38	37	, Data.Ini.Config.Raw
	38	, Data.Ini.Config.St
39	39	ghc-options: -Wall
40	40	build-depends: base >=4.7 && <4.10
41	41	, text >=1.2.2 && <1.3

-4

examples/lens-example/Main.hs less more

3	3
4	4	module Main where
5	5
6		import Data.Ini.Config.~~Lens~~
	6	import Data.Ini.Config.St
7	7	import Data.Text (Text)
8	8	import Lens.Micro.Platform (makeLenses)
9	9

22	22	, _confUseEncryption = True
23	23	}
24	24
25		parseConfig :: IniLensParser Config ()
26		parseConfig = sectionL "network" $ do
	25	parseConfig :: IniStParser Config ()
	26	parseConfig = sectionSt "network" $ do
27	27	confUsername .= field "user"
28	28	confPort .= fieldOf "port" number
29	29	confUseEncryption .=? fieldMbOf "encryption" flag

35	35
36	36	main :: IO ()
37	37	main = do
38		print (parseIniFileL example defaultConfig parseConfig)
	38	print (parseIniFileSt example defaultConfig parseConfig)

-340

~~src/Data/Ini/Config/Lens.hs~~ less more

1		{-# LANGUAGE RankNTypes #-}
2		{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3
4		module Data.Ini.Config.Lens
5		(
6		-- $main
7		-- * Running Lens-Based Parsers
8		parseIniFileL
9		-- * Lens-Aware Parser Types
10		, IniLensParser
11		, SectionLensParser
12		-- * Lens-Aware Section-Level Parsing
13		, sectionL
14		, sectionOptL
15		-- * Lens-Aware Field-Level Parsing
16		, lensField
17		, (.=)
18		, lensFieldOpt
19		, (.=?)
20		-- ** Lens-Aware Field Parsing Aliases
21		, fieldL
22		, fieldOfL
23		, fieldMbL
24		, fieldMbOfL
25		, fieldOptL
26		, fieldOptOfL
27		, fieldDefL
28		, fieldDefOfL
29		, fieldFlagL
30		, fieldFlagDefL
31		-- * Reader Functions
32		, Lens
33		, updateLens
34		, module Data.Ini.Config
35		) where
36
37		import Control.Applicative (Applicative(..), Alternative(..))
38		import Control.Monad.Trans.Class (lift)
39		import Control.Monad.Trans.Writer.Strict
40		import Data.Ini.Config
41		import Data.Monoid (Endo(..))
42		import Data.Text (Text)
43
44		-- $setup
45		-- >>> type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
46		--
47		-- >>> let lens get set f a = (`set` a) `fmap` f (get a)
48		--
49		-- >>> let _1 = lens fst (\ a (_, b) -> (a, b))
50		--
51		-- >>> let _2 = lens snd (\ b (a, _) -> (a, b))
52
53		-- \| This is a "lens"-compatible type alias
54		type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
55
56		-- We need this to implement 'set' for lenses
57		newtype I a = I { fromI :: a }
58		instance Functor I where fmap f (I a) = I (f a)
59
60		set :: Lens s s a a -> a -> s -> s
61		set lens x a = fromI (lens (\ _ -> I x) a)
62
63		-- \| This is a function compatible with the @fieldOf@ family of functions. It allows
64		-- you to parse a field and then create an update function with it.
65		updateLens :: (Text -> Either String a) -> Lens s s a a -> Text -> Either String (s -> s)
66		updateLens rd lens text = do
67		case rd text of
68		Left err -> Left err
69		Right r -> Right (\ st -> set lens r st)
70
71		newtype IniLensParser s a = IniLensParser (WriterT (Endo s) IniParser a)
72		deriving (Functor, Applicative, Alternative, Monad)
73
74		newtype SectionLensParser s a = SectionLensParser (WriterT (Endo s) SectionParser a)
75		deriving (Functor, Applicative, Alternative, Monad)
76
77		parseIniFileL :: Text -> s -> IniLensParser s () -> Either String s
78		parseIniFileL text def (IniLensParser mote) = do
79		(_, Endo update) <- parseIniFile text (runWriterT mote)
80		return (update def)
81
82		sectionL :: Text -> SectionLensParser s () -> IniLensParser s ()
83		sectionL name (SectionLensParser thunk) = IniLensParser $ do
84		((), update) <- lift (section name (runWriterT thunk))
85		tell update
86		return ()
87
88		sectionOptL :: Text -> SectionLensParser s () -> IniLensParser s ()
89		sectionOptL name (SectionLensParser thunk) = IniLensParser $ do
90		updateMb <- lift (sectionMb name (runWriterT thunk))
91		case updateMb of
92		Nothing -> return ()
93		Just ((), update) -> tell update
94
95		toLens :: Lens s s a a -> SectionParser a -> SectionLensParser s ()
96		toLens lens mote = SectionLensParser $ do
97		rs <- lift mote
98		tell $ Endo (set lens rs)
99
100		-- \| The 'lensField' function (or its operator form '.=') turns a lens and a
101		-- standard 'SectionParser' field into a 'SectionLensParser' that uses the
102		-- relevant lens to update an internal value to the result of the
103		-- 'SectionParser'.
104		--
105		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (lensField _1 (field "x"))
106		-- Right ("hello",False)
107		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (lensField _1 (field "y"))
108		-- Left "Missing field \"y\" in section \"MAIN\""
109		lensField :: Lens s s a a -> SectionParser a -> SectionLensParser s ()
110		lensField = toLens
111
112		-- \| An infix alias for 'lensField'.
113		--
114		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (_1 .= field "x")
115		-- Right ("hello",False)
116		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (_1 .= field "y")
117		-- Left "Missing field \"y\" in section \"MAIN\""
118		(.=) :: Lens s s a a -> SectionParser a -> SectionLensParser s ()
119		(.=) = toLens
120
121		-- \| The 'lensFieldOpt' function (or its operator form '.=?') turns a lens
122		-- and a standard 'SectionParser' field into a 'SectionLensParser' that
123		-- ignores values that are not present, but uses the lens to set a value
124		-- that is present.
125		--
126		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (lensFieldOpt _1 (fieldMb "x"))
127		-- Right ("hello",False)
128		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (lensFieldOpt _1 (fieldMb "y"))
129		-- Right ("def",False)
130		lensFieldOpt :: Lens s s a a -> SectionParser (Maybe a) -> SectionLensParser s ()
131		lensFieldOpt lens mote = SectionLensParser $ do
132		rsMb <- lift mote
133		case rsMb of
134		Just rs -> tell $ Endo (set lens rs)
135		Nothing -> return ()
136
137		-- \| An infix alias for 'lensFieldOpt'.
138		--
139		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (_1 .=? fieldMb "x")
140		-- Right ("hello",False)
141		-- >>> parseIniFileL"[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (_1 .=? fieldMb "y")
142		-- Right ("def",False)
143		(.=?) :: Lens s s a a -> SectionParser (Maybe a) -> SectionLensParser s ()
144		(.=?) = lensFieldOpt
145
146		-- \| A 'Lens'-aware variant of 'field': the 'Lens' argument names the
147		-- setter to use on the underlying value being modified.
148		--
149		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldL "x" _1)
150		-- Right ("hello",False)
151		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldL "y" _1)
152		-- Left "Missing field \"y\" in section \"MAIN\""
153		fieldL :: Text -> Lens s s Text Text -> SectionLensParser s ()
154		fieldL name lens = toLens lens $ field name
155
156		-- \| A 'Lens'-aware variant of 'fieldOf': the 'Lens' argument names the
157		-- setter to use on the underlying value being modified.
158		--
159		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldOfL "x" number _1)
160		-- Right (72,False)
161		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (0, False) $ sectionL "MAIN" (fieldOfL "x" number _1)
162		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
163		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldOfL "y" number _1)
164		-- Left "Missing field \"y\" in section \"MAIN\""
165		fieldOfL :: Text -> (Text -> Either String a) -> Lens s s a a -> SectionLensParser s ()
166		fieldOfL name rd lens = toLens lens $ fieldOf name rd
167
168
169		-- \| A 'Lens'-aware variant of 'fieldMb': the 'Lens' argument names the
170		-- setter to use on the underlying value being modified.
171		--
172		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (Just "def", False) $ sectionL "MAIN" (fieldMbL "x" _1)
173		-- Right (Just "hello",False)
174		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (Just "def", False) $ sectionL "MAIN" (fieldMbL "y" _1)
175		-- Right (Nothing,False)
176		fieldMbL :: Text -> Lens s s (Maybe Text) (Maybe Text) -> SectionLensParser s ()
177		fieldMbL name lens = toLens lens $ fieldMb name
178
179
180		-- \| A 'Lens'-aware variant of 'fieldMbOf': the 'Lens' argument names the
181		-- setter to use on the underlying value being modified.
182		--
183		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (Just 0, False) $ sectionL "MAIN" (fieldMbOfL "x" number _1)
184		-- Right (Just 72,False)
185		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (Just 0, False) $ sectionL "MAIN" (fieldMbOfL "x" number _1)
186		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
187		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (Just 0, False) $ sectionL "MAIN" (fieldMbOfL "y" number _1)
188		-- Right (Nothing,False)
189		fieldMbOfL :: Text -> (Text -> Either String a) -> Lens s s (Maybe a) (Maybe a) -> SectionLensParser s ()
190		fieldMbOfL name rd lens = toLens lens $ fieldMbOf name rd
191
192		-- \| A 'Lens'-aware variant of 'field' which does nothing if a key
193		-- is absent. The 'Lens' argument names the setter to use on the
194		-- underlying value being modified.
195		--
196		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldOptL "x" _1)
197		-- Right ("hello",False)
198		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldOptL "y" _1)
199		-- Right ("def",False)
200		fieldOptL :: Text -> Lens s s Text Text -> SectionLensParser s ()
201		fieldOptL name lens = SectionLensParser $ do
202		rsMb <- lift (fieldMb name)
203		case rsMb of
204		Nothing -> return ()
205		Just rs -> tell $ Endo (set lens rs)
206
207		-- \| A 'Lens'-aware variant of 'fieldOf', which does nothing if a key
208		-- is absent. The 'Lens' argument names the
209		-- setter to use on the underlying value being modified.
210		--
211		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldOptOfL "x" number _1)
212		-- Right (72,False)
213		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (0, False) $ sectionL "MAIN" (fieldOptOfL "x" number _1)
214		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
215		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldOptOfL "y" number _1)
216		-- Right (0,False)
217		fieldOptOfL :: Text -> (Text -> Either String a) -> Lens s s a a -> SectionLensParser s ()
218		fieldOptOfL name rd lens = SectionLensParser $ do
219		rsMb <- lift (fieldMbOf name rd)
220		case rsMb of
221		Nothing -> return ()
222		Just rs -> tell $ Endo (set lens rs)
223
224		-- \| A 'Lens'-aware variant of 'fieldDef': the 'Lens' argument names the
225		-- setter to use on the underlying value being modified.
226		--
227		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("orig", False) $ sectionL "MAIN" (fieldDefL "x" "def" _1)
228		-- Right ("hello",False)
229		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("orig", False) $ sectionL "MAIN" (fieldDefL "y" "def" _1)
230		-- Right ("def",False)
231		fieldDefL :: Text -> Text -> Lens s s Text Text -> SectionLensParser s ()
232		fieldDefL name def lens = toLens lens $ fieldDef name def
233
234		-- \| A 'Lens'-aware variant of 'fieldDefOf': the 'Lens' argument names the
235		-- setter to use on the underlying value being modified.
236		--
237		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldDefOfL "x" number 99 _1)
238		-- Right (72,False)
239		-- >>> parseIniFileL "[MAIN]\nx = hello\n" (0, False) $ sectionL "MAIN" (fieldDefOfL "x" number 99 _1)
240		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
241		-- >>> parseIniFileL "[MAIN]\nx = 72\n" (0, False) $ sectionL "MAIN" (fieldDefOfL "y" number 99 _1)
242		-- Right (99,False)
243		fieldDefOfL :: Text -> (Text -> Either String a) -> a -> Lens s s a a -> SectionLensParser s ()
244		fieldDefOfL name rd def lens = toLens lens $ fieldDefOf name rd def
245
246		-- \| A 'Lens'-aware variant of 'fieldFlag': the 'Lens' argument names the
247		-- setter to use on the underlying value being modified.
248		--
249		-- >>> parseIniFileL "[MAIN]\nx = yes\n" ("def", False) $ sectionL "MAIN" (fieldFlagL "x" _2)
250		-- Right ("def",True)
251		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldFlagL "x" _2)
252		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
253		-- >>> parseIniFileL "[MAIN]\nx = yes\n" ("def", False) $ sectionL "MAIN" (fieldFlagL "y" _2)
254		-- Left "Missing field \"y\" in section \"MAIN\""
255		fieldFlagL :: Text -> Lens s s Bool Bool -> SectionLensParser s ()
256		fieldFlagL name lens = toLens lens $ fieldFlag name
257
258		-- \| A 'Lens'-aware variant of 'fieldFlagDef': the 'Lens' argument names the
259		-- setter to use on the underlying value being modified.
260		--
261		-- >>> parseIniFileL "[MAIN]\nx = yes\n" ("def", False) $ sectionL "MAIN" (fieldFlagDefL "x" False _2)
262		-- Right ("def",True)
263		-- >>> parseIniFileL "[MAIN]\nx = hello\n" ("def", False) $ sectionL "MAIN" (fieldFlagDefL "x" False _2)
264		-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
265		-- >>> parseIniFileL "[MAIN]\nx = yes\n" ("def", False) $ sectionL "MAIN" (fieldFlagDefL "y" False _2)
266		-- Right ("def",False)
267		fieldFlagDefL :: Text -> Bool -> Lens s s Bool Bool -> SectionLensParser s ()
268		fieldFlagDefL name def lens = toLens lens $ fieldFlagDef name def
269
270
271		-- $main
272		-- This module is designed to be used with lenses, so that we can
273		-- start with a default configuration and gradually update it,
274		-- rather than construct a new value from scratch. Among other
275		-- things, this makes it nicer to section our API but keep all
276		-- the configuration together. Consider the same example code
277		-- that appears in the documentation for the "Data.Ini.Config"
278		-- module, that parses this kind of configuration:
279		--
280		-- > [NETWORK]
281		-- > host = example.com
282		-- > port = 7878
283		-- >
284		-- > # here is a comment
285		-- > [LOCAL]
286		-- > user = terry
287		--
288		-- In that example, we split the configuration into a @NetworkConfig@
289		-- and a @LocalConfig@ type to mirror the configuration file's use of
290		-- @[LOCAL]@ and @[NETWORK]@ sections, but we might want to keep the
291		-- configuration data type as a single flag record, in which case our
292		-- parsing code becomes more awkward:
293		--
294		-- > data Config = Config
295		-- > { _cfHost :: String
296		-- > , _cfPort :: Int
297		-- > , _cfUser :: Text
298		-- > } deriving (Eq, Show)
299		-- >
300		-- > -- this is not ideal
301		-- > configParser :: IniParser Config
302		-- > configParser = do
303		-- > (host, port) <- section "NETWORK" $ do
304		-- > host <- fieldOf "host" string
305		-- > port <- fieldOf "port" number
306		-- > return (host, port)
307		-- > user <- section "LOCAL" $ field "user"
308		-- > return (Config host port user)
309		--
310		-- We could also use repeated invocations of 'section', but this
311		-- also makes our parsing code a lot uglier and involves unnecessary
312		-- repetition of the @\"NETWORK\"@ literal:
313		--
314		-- > -- this is kind of ugly
315		-- > configParser :: IniParser Config
316		-- > configParser = do
317		-- > host <- section "NETWORK" $ fieldOf "host" string
318		-- > port <- section "NETWORK" $ fieldOf "port" number
319		-- > user <- section "LOCAL" $ field "user"
320		-- > return (Config host port user)
321		--
322		-- Assuming that we generate lenses for the @Config@ type above,
323		-- then we can use the lens-based combinators in this module to
324		-- write terser parsing code by providing which lens to update
325		-- along with each field:
326		--
327		-- > configParser :: IniLensParser Config ()
328		-- > configParser = do
329		-- > section "NETWORK" $ do
330		-- > cfHost .= fieldOf "host" string
331		-- > cfPort .= fieldOf "port" number
332		-- > section "LOCAL" $ do
333		-- > cfUser .= field "user"
334		--
335		-- One downside to this approach is that you need an existing
336		-- value of the configuration type to update, which might mean
337		-- filling in a dummy value with nonsense data, even for fields
338		-- which are obligatory in the configuration, but on the other
339		-- hand, this can make some parsing code much more flexible and
340		-- terse.

+374

-0

src/Data/Ini/Config/St.hs less more

	1	{-# LANGUAGE RankNTypes #-}
	2	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
	3
	4	module Data.Ini.Config.St
	5	(
	6	-- $main
	7	-- * Running Setter-Based Parsers
	8	parseIniFileSt
	9	-- * Setter-Based Parser Types
	10	, IniStParser
	11	, SectionStParser
	12	-- * Setter-Based Section-Level Parsing
	13	, sectionSt
	14	, sectionOptSt
	15	-- * Setter-Aware Field-Level Parsing
	16	-- ** Using setter functions
	17	, setterField
	18	, setterFieldOpt
	19	-- ** Using lenses
	20	, lensField
	21	, (.=)
	22	, lensFieldOpt
	23	, (.=?)
	24	-- ** Setter-Based Field Parsing Aliases
	25	, fieldSt
	26	, fieldOfSt
	27	, fieldMbSt
	28	, fieldMbOfSt
	29	, fieldOptSt
	30	, fieldOptOfSt
	31	, fieldDefSt
	32	, fieldDefOfSt
	33	, fieldFlagSt
	34	, fieldFlagDefSt
	35	-- * Reader Functions
	36	, Lens
	37	, updateLens
	38	, module Data.Ini.Config
	39	) where
	40
	41	import Control.Applicative (Applicative(..), Alternative(..))
	42	import Control.Monad.Trans.Class (lift)
	43	import Control.Monad.Trans.Writer.Strict
	44	import Data.Ini.Config
	45	import Data.Monoid (Endo(..))
	46	import Data.Text (Text)
	47
	48	-- $setup
	49	-- >>> type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
	50	--
	51	-- >>> let lens get set f a = (`set` a) `fmap` f (get a)
	52	--
	53	-- >>> let _1 = lens fst (\ a (_, b) -> (a, b))
	54	--
	55	-- >>> let _2 = lens snd (\ b (a, _) -> (a, b))
	56	--
	57	-- >>> let set lens x a = fromI (lens (\ _ -> I x) a)
	58
	59	-- \| This is a "lens"-compatible type alias
	60	type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
	61
	62	-- We need this to implement 'set' for lenses
	63	newtype I a = I { fromI :: a }
	64	instance Functor I where fmap f (I a) = I (f a)
	65
	66	set :: Lens s s a a -> a -> s -> s
	67	set lens x a = fromI (lens (\ _ -> I x) a)
	68
	69	-- \| This is a function compatible with the @fieldOf@ family of functions. It allows
	70	-- you to parse a field and then create an update function with it.
	71	updateLens :: (Text -> Either String a) -> Lens s s a a -> Text -> Either String (s -> s)
	72	updateLens rd lens text = do
	73	case rd text of
	74	Left err -> Left err
	75	Right r -> Right (\ st -> set lens r st)
	76
	77	newtype IniStParser s a = IniStParser (WriterT (Endo s) IniParser a)
	78	deriving (Functor, Applicative, Alternative, Monad)
	79
	80	newtype SectionStParser s a = SectionStParser (WriterT (Endo s) SectionParser a)
	81	deriving (Functor, Applicative, Alternative, Monad)
	82
	83	parseIniFileSt :: Text -> s -> IniStParser s () -> Either String s
	84	parseIniFileSt text def (IniStParser mote) = do
	85	(_, Endo update) <- parseIniFile text (runWriterT mote)
	86	return (update def)
	87
	88	sectionSt :: Text -> SectionStParser s () -> IniStParser s ()
	89	sectionSt name (SectionStParser thunk) = IniStParser $ do
	90	((), update) <- lift (section name (runWriterT thunk))
	91	tell update
	92	return ()
	93
	94	sectionOptSt :: Text -> SectionStParser s () -> IniStParser s ()
	95	sectionOptSt name (SectionStParser thunk) = IniStParser $ do
	96	updateMb <- lift (sectionMb name (runWriterT thunk))
	97	case updateMb of
	98	Nothing -> return ()
	99	Just ((), update) -> tell update
	100
	101	liftSetter :: (a -> s -> s) -> SectionParser a -> SectionStParser s ()
	102	liftSetter setter mote = SectionStParser $ do
	103	rs <- lift mote
	104	tell $ Endo (setter rs)
	105
	106	-- \| The 'setterField' function turns a setter and a relevant 'SectionParser'
	107	-- field into a 'SectionStParser' that uses the setter to update
	108	-- an internal value using the result of the 'SectionParser'.
	109	--
	110	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (setterField (set _1) (field "x"))
	111	-- Right ("hello",False)
	112	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (setterField (set _1) (field "y"))
	113	-- Left "Missing field \"y\" in section \"MAIN\""
	114	setterField :: (a -> s -> s) -> SectionParser a -> SectionStParser s ()
	115	setterField = liftSetter
	116
	117	-- \| The 'setterFieldOpt' function turns a setter and a relevant 'SectionParser'
	118	-- field into a 'SectionStParser' that uses the setter to update an internal
	119	-- value with the 'Just' result from the 'SectionParser', and does nothing
	120	-- if the 'SectionParser' returns 'Nothing'.
	121	--
	122	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (setterFieldOpt (set _1) (fieldMb "x"))
	123	-- Right ("hello",False)
	124	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (setterFieldOpt (set _1) (fieldMb "y"))
	125	-- Right ("def",False)
	126	setterFieldOpt :: (a -> s -> s) -> SectionParser (Maybe a) -> SectionStParser s ()
	127	setterFieldOpt setter mote = SectionStParser $ do
	128	rsMb <- lift mote
	129	case rsMb of
	130	Just rs -> tell $ Endo (setter rs)
	131	Nothing -> return ()
	132
	133	-- \| The 'lensField' function (or its operator form '.=') turns a lens and a
	134	-- standard 'SectionParser' field into a 'SectionStParser' that uses the
	135	-- lens to update an internal value to the result of the
	136	-- 'SectionParser'.
	137	--
	138	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (lensField _1 (field "x"))
	139	-- Right ("hello",False)
	140	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (lensField _1 (field "y"))
	141	-- Left "Missing field \"y\" in section \"MAIN\""
	142	lensField :: Lens s s a a -> SectionParser a -> SectionStParser s ()
	143	lensField lens mote = SectionStParser $ do
	144	rs <- lift mote
	145	tell $ Endo (set lens rs)
	146
	147	-- \| An infix alias for 'lensField'.
	148	--
	149	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (_1 .= field "x")
	150	-- Right ("hello",False)
	151	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (_1 .= field "y")
	152	-- Left "Missing field \"y\" in section \"MAIN\""
	153	(.=) :: Lens s s a a -> SectionParser a -> SectionStParser s ()
	154	(.=) = lensField
	155
	156	-- \| The 'lensFieldOpt' function (or its operator form '.=?') turns a lens
	157	-- and a standard 'SectionParser' field into a 'SectionStParser' that
	158	-- ignores values that are not present, but uses the lens to set a value
	159	-- that is present.
	160	--
	161	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (lensFieldOpt _1 (fieldMb "x"))
	162	-- Right ("hello",False)
	163	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (lensFieldOpt _1 (fieldMb "y"))
	164	-- Right ("def",False)
	165	lensFieldOpt :: Lens s s a a -> SectionParser (Maybe a) -> SectionStParser s ()
	166	lensFieldOpt lens mote = SectionStParser $ do
	167	rsMb <- lift mote
	168	case rsMb of
	169	Just rs -> tell $ Endo (set lens rs)
	170	Nothing -> return ()
	171
	172	-- \| An infix alias for 'lensFieldOpt'.
	173	--
	174	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (_1 .=? fieldMb "x")
	175	-- Right ("hello",False)
	176	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (_1 .=? fieldMb "y")
	177	-- Right ("def",False)
	178	(.=?) :: Lens s s a a -> SectionParser (Maybe a) -> SectionStParser s ()
	179	(.=?) = lensFieldOpt
	180
	181	-- \| A setter-aware variant of 'field': the setter argument names the
	182	-- setter to use on the underlying value being modified.
	183	--
	184	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldSt "x" (set _1))
	185	-- Right ("hello",False)
	186	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldSt "y" (set _1))
	187	-- Left "Missing field \"y\" in section \"MAIN\""
	188	fieldSt :: Text -> (Text -> s -> s) -> SectionStParser s ()
	189	fieldSt name setter = liftSetter setter $ field name
	190
	191	-- \| A setter-aware variant of 'fieldOf': the setter argument names the
	192	-- setter to use on the underlying value being modified.
	193	--
	194	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldOfSt "x" number (set _1))
	195	-- Right (72,False)
	196	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (0, False) $ sectionSt "MAIN" (fieldOfSt "x" number (set _1))
	197	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
	198	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldOfSt "y" number (set _1))
	199	-- Left "Missing field \"y\" in section \"MAIN\""
	200	fieldOfSt :: Text -> (Text -> Either String a) -> (a -> s -> s) -> SectionStParser s ()
	201	fieldOfSt name rd setter = liftSetter setter $ fieldOf name rd
	202
	203	-- \| A setter-aware variant of 'fieldMb': the setter argument names the
	204	-- setter to use on the underlying value being modified.
	205	--
	206	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (Just "def", False) $ sectionSt "MAIN" (fieldMbSt "x" (set _1))
	207	-- Right (Just "hello",False)
	208	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (Just "def", False) $ sectionSt "MAIN" (fieldMbSt "y" (set _1))
	209	-- Right (Nothing,False)
	210	fieldMbSt :: Text -> (Maybe Text -> s -> s) -> SectionStParser s ()
	211	fieldMbSt name setter = liftSetter setter $ fieldMb name
	212
	213	-- \| A setter-aware variant of 'fieldMbOf': the setter argument names the
	214	-- setter to use on the underlying value being modified.
	215	--
	216	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (Just 0, False) $ sectionSt "MAIN" (fieldMbOfSt "x" number (set _1))
	217	-- Right (Just 72,False)
	218	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (Just 0, False) $ sectionSt "MAIN" (fieldMbOfSt "x" number (set _1))
	219	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
	220	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (Just 0, False) $ sectionSt "MAIN" (fieldMbOfSt "y" number (set _1))
	221	-- Right (Nothing,False)
	222	fieldMbOfSt :: Text -> (Text -> Either String a) -> (Maybe a -> s -> s) -> SectionStParser s ()
	223	fieldMbOfSt name rd setter = liftSetter setter $ fieldMbOf name rd
	224
	225	-- \| A setter-aware variant of 'field' which does nothing if a key
	226	-- is absent. The setter argument names the setter to use on the
	227	-- underlying value being modified.
	228	--
	229	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldOptSt "x" (set _1))
	230	-- Right ("hello",False)
	231	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldOptSt "y" (set _1))
	232	-- Right ("def",False)
	233	fieldOptSt :: Text -> (Text -> s -> s) -> SectionStParser s ()
	234	fieldOptSt name setter = SectionStParser $ do
	235	rsMb <- lift (fieldMb name)
	236	case rsMb of
	237	Nothing -> return ()
	238	Just rs -> tell $ Endo (setter rs)
	239
	240	-- \| A setter-aware variant of 'fieldOf', which does nothing if a key
	241	-- is absent. The setter argument names the
	242	-- setter to use on the underlying value being modified.
	243	--
	244	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldOptOfSt "x" number (set _1))
	245	-- Right (72,False)
	246	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (0, False) $ sectionSt "MAIN" (fieldOptOfSt "x" number (set _1))
	247	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
	248	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldOptOfSt "y" number (set _1))
	249	-- Right (0,False)
	250	fieldOptOfSt :: Text -> (Text -> Either String a) -> (a -> s -> s) -> SectionStParser s ()
	251	fieldOptOfSt name rd setter = SectionStParser $ do
	252	rsMb <- lift (fieldMbOf name rd)
	253	case rsMb of
	254	Nothing -> return ()
	255	Just rs -> tell $ Endo (setter rs)
	256
	257	-- \| A setter-aware variant of 'fieldDef': the setter argument names the
	258	-- setter to use on the underlying value being modified.
	259	--
	260	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("orig", False) $ sectionSt "MAIN" (fieldDefSt "x" "def" (set _1))
	261	-- Right ("hello",False)
	262	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("orig", False) $ sectionSt "MAIN" (fieldDefSt "y" "def" (set _1))
	263	-- Right ("def",False)
	264	fieldDefSt :: Text -> Text -> (Text -> s -> s) -> SectionStParser s ()
	265	fieldDefSt name def setter = liftSetter setter $ fieldDef name def
	266
	267	-- \| A setter-aware variant of 'fieldDefOf': the setter argument names the
	268	-- setter to use on the underlying value being modified.
	269	--
	270	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldDefOfSt "x" number 99 (set _1))
	271	-- Right (72,False)
	272	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" (0, False) $ sectionSt "MAIN" (fieldDefOfSt "x" number 99 (set _1))
	273	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
	274	-- >>> parseIniFileSt "[MAIN]\nx = 72\n" (0, False) $ sectionSt "MAIN" (fieldDefOfSt "y" number 99 (set _1))
	275	-- Right (99,False)
	276	fieldDefOfSt :: Text -> (Text -> Either String a) -> a -> (a -> s -> s) -> SectionStParser s ()
	277	fieldDefOfSt name rd def setter = liftSetter setter $ fieldDefOf name rd def
	278
	279	-- \| A setter-aware variant of 'fieldFlag': the setter argument names the
	280	-- setter to use on the underlying value being modified.
	281	--
	282	-- >>> parseIniFileSt "[MAIN]\nx = yes\n" ("def", False) $ sectionSt "MAIN" (fieldFlagSt "x" (set _2))
	283	-- Right ("def",True)
	284	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldFlagSt "x" (set _2))
	285	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
	286	-- >>> parseIniFileSt "[MAIN]\nx = yes\n" ("def", False) $ sectionSt "MAIN" (fieldFlagSt "y" (set _2))
	287	-- Left "Missing field \"y\" in section \"MAIN\""
	288	fieldFlagSt :: Text -> (Bool -> s -> s) -> SectionStParser s ()
	289	fieldFlagSt name setter = liftSetter setter $ fieldFlag name
	290
	291	-- \| A setter-aware variant of 'fieldFlagDef': the setter argument names the
	292	-- setter to use on the underlying value being modified.
	293	--
	294	-- >>> parseIniFileSt "[MAIN]\nx = yes\n" ("def", False) $ sectionSt "MAIN" (fieldFlagDefSt "x" False (set _2))
	295	-- Right ("def",True)
	296	-- >>> parseIniFileSt "[MAIN]\nx = hello\n" ("def", False) $ sectionSt "MAIN" (fieldFlagDefSt "x" False (set _2))
	297	-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
	298	-- >>> parseIniFileSt "[MAIN]\nx = yes\n" ("def", False) $ sectionSt "MAIN" (fieldFlagDefSt "y" False (set _2))
	299	-- Right ("def",False)
	300	fieldFlagDefSt :: Text -> Bool -> (Bool -> s -> s) -> SectionStParser s ()
	301	fieldFlagDefSt name def setter = liftSetter setter $ fieldFlagDef name def
	302
	303
	304	-- $main
	305	-- This module is designed to be used with update functions
	306	-- like setters or leneses, so that we can
	307	-- start with a default configuration and gradually update it,
	308	-- rather than construct a new value from scratch. Among other
	309	-- things, this introduces more flexibility in terms of how we
	310	-- organize both the configuration file and the data type that
	311	-- represents the configuration. Consider the same example code
	312	-- that appears in the documentation for the "Data.Ini.Config"
	313	-- module, which parses a configuration file like this:
	314	--
	315	-- > [NETWORK]
	316	-- > host = example.com
	317	-- > port = 7878
	318	-- >
	319	-- > [LOCAL]
	320	-- > user = terry
	321	--
	322	-- In that example, we split the configuration into a @NetworkConfig@
	323	-- and a @LocalConfig@ type to mirror the configuration file's use of
	324	-- @[LOCAL]@ and @[NETWORK]@ sections, but we might want to keep the
	325	-- configuration data type as a single flat record, in which case our
	326	-- parsing code becomes more awkward:
	327	--
	328	-- > data Config = Config
	329	-- > { _cfHost :: String
	330	-- > , _cfPort :: Int
	331	-- > , _cfUser :: Text
	332	-- > } deriving (Eq, Show)
	333	-- >
	334	-- > -- this is not ideal
	335	-- > configParser :: IniParser Config
	336	-- > configParser = do
	337	-- > (host, port) <- section "NETWORK" $ do
	338	-- > host <- fieldOf "host" string
	339	-- > port <- fieldOf "port" number
	340	-- > return (host, port)
	341	-- > user <- section "LOCAL" $ field "user"
	342	-- > return (Config host port user)
	343	--
	344	-- We could also use repeated invocations of 'section', but this
	345	-- also makes our parsing code a lot uglier and involves unnecessary
	346	-- repetition of the @\"NETWORK\"@ literal:
	347	--
	348	-- > -- this is kind of ugly
	349	-- > configParser :: IniParser Config
	350	-- > configParser = do
	351	-- > host <- section "NETWORK" $ fieldOf "host" string
	352	-- > port <- section "NETWORK" $ fieldOf "port" number
	353	-- > user <- section "LOCAL" $ field "user"
	354	-- > return (Config host port user)
	355	--
	356	-- Assuming that we generate lenses for the @Config@ type above,
	357	-- then we can use the lens-based combinators in this module to
	358	-- write terser parsing code by providing which lens to update
	359	-- along with each field:
	360	--
	361	-- > configParser :: IniStParser Config ()
	362	-- > configParser = do
	363	-- > sectionSt "NETWORK" $ do
	364	-- > cfHost .= fieldOf "host" string
	365	-- > cfPort .= fieldOf "port" number
	366	-- > sectionSt "LOCAL" $ do
	367	-- > cfUser .= field "user"
	368	--
	369	-- One downside to this approach is that you need an existing
	370	-- value of the configuration type to update, which might mean
	371	-- filling in a dummy value with nonsense data, even for fields
	372	-- which are obligatory in the configuration but on the other
	373	-- hand, this can make some parsing code much more flexible and
	374	-- terse.

-1

test/doctest/Main.hs less more

5	5	main :: IO ()
6	6	main = do
7	7	doctest [ "src/Data/Ini/Config.hs", "-XOverloadedStrings" ]
8		doctest [ "src/Data/Ini/Config/~~Lens~~.hs", "-XRankNTypes", "-XOverloadedStrings" ]
	8	doctest [ "src/Data/Ini/Config/St.hs", "-XRankNTypes", "-XOverloadedStrings" ]