Commit 078936334cff8b5a86e8765aad1f1362de05678e - config-ini

Merge branch 'bidir' Getty Ritter 6 years ago

12 changed file(s) with 1948 addition(s) and 544 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 `Config` value at the end, once we have all three of its fields:
	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 unfortunately awkward and repetitive. An alternative is to flatten it out by repeating invocations of `section` like below, 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	In situations like these, you can instead 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 value, and parsing a field allows you to _update_ that configuration with the value of a field. The monads exported by this module have an extra type parameter that represents the type of the value being updated. The easiest way to use this module is by combining lenses with 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 the biggest downside to this approach: in this case, even though the `host` and `port` fields are obligatory and will be overwritten by the parser, we still 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 `IniStParser` implementation isn't tied to lenses, and many of the functions exported by `Data.Ini.Config.St` expected any generic function of the type `a -> s -> s`, and not a lens specifically. If we didn't want to use lenses, we can still take advantage of this library, albeit 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.

+25

-8

config-ini.cabal less more

1	1	name: config-ini
2		version: 0.~~1.2.1~~
	2	version: 0.2.0.0
3	3	synopsis: A library for simple INI-based configuration files.
4	4	homepage: https://github.com/aisamanra/config-ini
5	5	bug-reports: https://github.com/aisamanra/config-ini/issues
6		description: The @config-ini@ library is a s~~mall monadic language~~
	6	description: The @config-ini@ library is a set of small monadic languages
7	7	for writing simple configuration languages with convenient,
8	8	human-readable error messages.
9	9	.

35	35	library
36	36	hs-source-dirs: src
37	37	exposed-modules: Data.Ini.Config
	38	, Data.Ini.Config.Bidir
38	39	, Data.Ini.Config.Raw
39	40	ghc-options: -Wall
40		build-depends: base >=4.7 && <5
	41	build-depends: base >=4.8 && <5
	42	, containers
41	43	, text >=1.2.2 && <1.3
42	44	, unordered-containers >=0.2.7 && <0.3
43	45	, transformers >=0.4.1 && <0.6
44		, megaparsec >=~~5.1.2 && <5.2~~
	46	, megaparsec >=6 && <7
45	47	default-language: Haskell2010
46	48
47	49	executable basic-example

50	52	hs-source-dirs: examples/basic-example
51	53	main-is: Main.hs
52	54	ghc-options: -Wall
53		build-depends: base >=4.7 && <5
	55	build-depends: base >=4.8 && <5
54	56	, text
55	57	, config-ini
	58	default-language: Haskell2010
	59
	60	executable bidir-example
	61	if !flag(build-examples)
	62	buildable: False
	63	hs-source-dirs: examples/bidir-example
	64	main-is: Main.hs
	65	ghc-options: -Wall
	66	build-depends: base >=4.8 && <5
	67	, text
	68	, config-ini
	69	, microlens-th
56	70	default-language: Haskell2010
57	71
58	72	executable config-example

61	75	hs-source-dirs: examples/config-example
62	76	main-is: Main.hs
63	77	ghc-options: -Wall
64		build-depends: base >=4.7 && <5
	78	build-depends: base >=4.8 && <5
65	79	, text
66	80	, config-ini
	81	, microlens-platform
67	82	default-language: Haskell2010
68	83
69	84	test-suite test-ini-compat
70	85	type: exitcode-stdio-1.0
71		ghc-options: -Wall
	86	ghc-options: -Wall -threaded
72	87	default-language: Haskell2010
73	88	hs-source-dirs: test/ini-compat
74	89	main-is: Main.hs
75	90	build-depends: base
76	91	, ini
77	92	, config-ini
78		, ~~QuickCheck~~
	93	, hedgehog
	94	, containers
79	95	, unordered-containers
80	96	, text
81	97

87	103	main-is: Main.hs
88	104	build-depends: base
89	105	, config-ini
	106	, containers
90	107	, unordered-containers
91	108	, text
92	109	, directory

+82

-0

examples/bidir-example/Main.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2	{-# LANGUAGE OverloadedLists #-}
	3	{-# LANGUAGE TemplateHaskell #-}
	4
	5	module Main where
	6
	7	import Data.Ini.Config.Bidir
	8	import Data.Text (Text, unpack)
	9	import Lens.Micro.TH (makeLenses)
	10
	11	data Config = Config
	12	{ _confUsername :: Text
	13	, _confPort :: Int
	14	, _confUseEncryption :: Bool
	15	, _confHostname :: Text
	16	, _confConfigFile :: Maybe Text
	17	, _confPath :: [Text]
	18	} deriving (Eq, Show)
	19
	20	makeLenses ''Config
	21
	22	sampleConfig :: Config
	23	sampleConfig = Config
	24	{ _confUsername = "<user>"
	25	, _confPort = 8080
	26	, _confUseEncryption = True
	27	, _confHostname = "localhost"
	28	, _confConfigFile = Nothing
	29	, _confPath = ["/bin"]
	30	}
	31
	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	& optional
	41	& comment [ "whether to use encryption (defaults to true)" ]
	42	confHostname .= field "hostname" text
	43	& optional
	44	& comment [ "hostname to connect to (optional)" ]
	45	confConfigFile .=? field "config file" text
	46	& placeholderValue "<file path>"
	47	section "LOCAL" & allOptional $ do
	48	confPath .= field "path" (listWithSeparator ":" text)
	49	& comment [ "a colon-separated path list" ]
	50
	51	example :: Text
	52	example = "[NETWORK]\n\
	53	\# this contains a comment\n\
	54	\; and a semicolon comment\n\
	55	\user: gdritter\n\
	56	\port: 8888\n"
	57
	58	main :: IO ()
	59	main = do
	60	let s = parseIni example configSpec
	61	case s of
	62	Left err -> putStrLn err
	63	Right p -> do
	64	let v = getIniValue p
	65	print v
	66	putStrLn "------------------------"
	67	putStr (unpack (serializeIni configSpec))
	68	putStrLn "------------------------"
	69	let v' = v { _confPort = 9191
	70	, _confHostname = "argl"
	71	, _confPath = "/usr/sbin" : _confPath v
	72	}
	73	let pol = defaultUpdatePolicy
	74	{ updateGeneratedCommentPolicy =
	75	CommentPolicyAddDefaultComment
	76	[ "value added by application" ]
	77	, updateIgnoreExtraneousFields = False
	78	}
	79	let up = serializeIni $ updateIni v' $ setIniUpdatePolicy pol p
	80	putStrLn "------------------------"
	81	putStr (unpack up)
	82	putStrLn "------------------------"

-38

~~examples/lens-example/Main.hs~~ less more

1		{-# LANGUAGE OverloadedStrings #-}
2		{-# LANGUAGE TemplateHaskell #-}
3
4		module Main where
5
6		import Data.Ini.Config.Lens
7		import Data.Text (Text)
8		import Lens.Micro.Platform (makeLenses)
9
10		data Config = Config
11		{ _confUsername :: Text
12		, _confPort :: Int
13		, _confUseEncryption :: Bool
14		} deriving (Eq, Show)
15
16		makeLenses ''Config
17
18		defaultConfig :: Config
19		defaultConfig = Config
20		{ _confUsername = "undefined"
21		, _confPort = 0
22		, _confUseEncryption = True
23		}
24
25		parseConfig :: IniLensParser Config ()
26		parseConfig = sectionL "network" $ do
27		confUsername .= field "user"
28		confPort .= fieldOf "port" number
29		confUseEncryption .=? fieldMbOf "encryption" flag
30
31		example :: Text
32		example = "[NETWORK]\n\
33		\user = gdritter\n\
34		\port = 8888\n"
35
36		main :: IO ()
37		main = do
38		print (parseIniFileL example defaultConfig parseConfig)

+952

-0

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

	1	{-\|
	2	Module : Data.Ini.Config.Bidir
	3	Copyright : (c) Getty Ritter, 2017
	4	License : BSD
	5	Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
	6	Stability : experimental
	7
	8	This module presents an alternate API for parsing INI files. Unlike
	9	the standard API, it is bidirectional: the same declarative structure
	10	can be used to parse an INI file to a value, serialize an INI file
	11	from a value, or even /update/ an INI file by comparing it against a
	12	value and serializing in a way that minimizes the differences between
	13	revisions of the file.
	14
	15	This API does make some extra assumptions about your configuration
	16	type and the way you interact with it: in particular, it assumes that
	17	you have lenses for all the fields you're parsing and that you have
	18	some kind of sensible default value of that configuration
	19	type. Instead of providing combinators which can extract and parse a
	20	field of an INI file into a value, the bidirectional API allows you to
	21	declaratively associate a lens into your structure with a field of the
	22	INI file.
	23
	24	Consider the following example INI file:
	25
	26	> [NETWORK]
	27	> host = example.com
	28	> port = 7878
	29	>
	30	> [LOCAL]
	31	> user = terry
	32
	33	We'd like to parse this INI file into a @Config@ type which we've
	34	defined like this, using
	35	<https://hackage.haskell.org/package/lens lens> or a similar library
	36	to provide lenses:
	37
	38	> data Config = Config
	39	> { _cfHost :: String
	40	> , _cfPort :: Int
	41	> , _cfUser :: Maybe Text
	42	> } deriving (Eq, Show)
	43	>
	44	> ''makeLenses Config
	45
	46	We can now define a basic specification of the type @'IniSpec' Config
	47	()@ by using the provided operations to declare our top-level
	48	sections, and then within those sections we can associate fields with
	49	@Config@ lenses.
	50
	51	@
	52	'configSpec' :: 'IniSpec' Config ()
	53	'configSpec' = do
	54	'section' \"NETWORK\" $ do
	55	cfHost '.=' 'field' \"host\" 'string'
	56	cfPost '.=' 'field' \"port\" 'number'
	57	'sectionOpt' \"LOCAL\" $ do
	58	cfUser '.=?' 'field' \"user\" 'text'
	59	@
	60
	61	There are two operators used to associate lenses with fields:
	62
	63	['.='] Associates a lens of type @Lens' s a@ with a field description
	64	of type @FieldDescription a@. By default, this will raise an
	65	error when parsing if the field described is missing, but we
	66	can mark it as optional, as we'll see.
	67
	68	['.=?'] Associates a lens of type @Lens' s (Maybe a)@ with a field
	69	description of type @FieldDescription a@. During parsing, if
	70	the value does not appear in an INI file, then the lens will
	71	be set to 'Nothing'; similarly, during serializing, if the
	72	value is 'Nothing', then the field will not be serialized in
	73	the file.
	74
	75	Each field must include the field's name as well as a 'FieldValue',
	76	which describes how to both parse and serialize a value of a given
	77	type. Several built-in 'FieldValue' descriptions are provided, but you
	78	can always build your own by providing parsing and serialization
	79	functions for individual fields.
	80
	81	We can also provide extra metadata about a field, allowing it to be
	82	skipped durin parsing, or to provide an explicit default value, or to
	83	include an explanatory comment for that value to be used when we
	84	serialize an INI file. These are conventionally applied to the field
	85	using the '&' operator:
	86
	87	@
	88	configSpec :: 'IniSpec' Config ()
	89	configSpec = do
	90	'section' \"NETWORK\" $ do
	91	cfHost '.=' 'field' \"host\" 'string'
	92	& 'comment' [\"The desired hostname (optional)\"]
	93	& 'skipIfMissing'
	94	cfPost '.=' 'field' \"port\" 'number'
	95	& 'comment' [\"The port number\"]
	96	'sectionOpt' \"LOCAL\" $ do
	97	cfUser '.=?' 'field' \"user\" 'text'
	98	@
	99
	100	When we want to use this specification, we need to create a value of
	101	type 'Ini', which is an abstract representation of an INI
	102	specification. To create an 'Ini' value, we need to use the 'ini'
	103	function, which combines the spec with the default version of our
	104	configuration value.
	105
	106	Once we have a value of type 'Ini', we can use it for three basic
	107	operations:
	108
	109	* We can parse a textual INI file with 'parseIni', which will
	110	systematically walk the spec and use the provided lens/field
	111	associations to create a parsed configuration file. This will give
	112	us a new value of type 'Ini' that represents the parsed
	113	configuration, and we can extract the actual configuration value
	114	with 'getIniValue'.
	115
	116	* We can update the value contained in an 'Ini' value. If the 'Ini'
	117	value is the result of a previous call to 'parseIni', then this
	118	update will attempt to retain as much of the incidental structure of
	119	the parsed file as it can: for example, it will attempt to retain
	120	comments, whitespace, and ordering. The general strategy is to make
	121	the resulting INI file "diff-minimal": the diff between the older
	122	INI file and the updated INI file should contain as little noise as
	123	possible. Small cosmetic choices such as how to treat generated
	124	comments are controlled by a configurable 'UpdatePolicy' value.
	125
	126	* We can serialize an 'Ini' value to a textual INI file. This will
	127	produce the specified INI file (either a default fresh INI, or a
	128	modified existing INI) as a textual value.
	129
	130	-}
	131
	132	{-# LANGUAGE CPP #-}
	133	{-# LANGUAGE RankNTypes #-}
	134	{-# LANGUAGE OverloadedStrings #-}
	135	{-# LANGUAGE ScopedTypeVariables #-}
	136	{-# LANGUAGE ExistentialQuantification #-}
	137	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
	138	{-# LANGUAGE MultiWayIf #-}
	139
	140	module Data.Ini.Config.Bidir
	141	(
	142	-- * Parsing, Serializing, and Updating Files
	143	-- $using
	144	Ini
	145	, ini
	146	, getIniValue
	147	, getRawIni
	148	-- ** Parsing INI files
	149	, parseIni
	150	-- ** Serializing INI files
	151	, serializeIni
	152	-- ** Updating INI Files
	153	, updateIni
	154	, setIniUpdatePolicy
	155	, UpdatePolicy(..)
	156	, UpdateCommentPolicy(..)
	157	, defaultUpdatePolicy
	158	-- * Bidirectional Parser Types
	159	-- $types
	160	, IniSpec
	161	, SectionSpec
	162
	163	-- * Section-Level Parsing
	164	-- $sections
	165	, section
	166	, allOptional
	167
	168	-- * Field-Level Parsing
	169	-- $fields
	170	, FieldDescription
	171	, (.=)
	172	, (.=?)
	173	, field
	174	, flag
	175	, comment
	176	, placeholderValue
	177	, optional
	178
	179	-- * FieldValues
	180	-- $fieldvalues
	181	, FieldValue(..)
	182	, text
	183	, string
	184	, number
	185	, bool
	186	, readable
	187	, listWithSeparator
	188	, pairWithSeparator
	189
	190	-- * Miscellaneous Helpers
	191	-- $misc
	192	, (&)
	193	, Lens
	194
	195	) where
	196
	197	import Control.Monad.Trans.State.Strict (State, runState, modify)
	198	import qualified Control.Monad.Trans.State.Strict as State
	199	import qualified Data.Foldable as F
	200	#if __GLASGOW_HASKELL__ >= 710
	201	import Data.Function ((&))
	202	#endif
	203	import Data.Monoid ((<>))
	204	import Data.Sequence ((<\|), Seq, ViewL(..), ViewR(..))
	205	import qualified Data.Sequence as Seq
	206	import Data.Text (Text)
	207	import qualified Data.Text as T
	208	import qualified Data.Traversable as F
	209	import Data.Typeable (Typeable, Proxy(..), typeRep)
	210	import GHC.Exts (IsList(..))
	211	import Text.Read (readMaybe)
	212
	213	import Data.Ini.Config.Raw
	214
	215	-- * Utility functions + lens stuffs
	216
	217	-- \| This is a
	218	-- <https://hackage.haskell.org/package/lens lens>-compatible
	219	-- type alias
	220	type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
	221
	222	-- These are some inline reimplementations of "lens" operators. We
	223	-- need the identity functor to implement 'set':
	224	newtype I a = I { fromI :: a }
	225	instance Functor I where fmap f (I x) = I (f x)
	226
	227	set :: Lens s t a b -> b -> s -> t
	228	set lns x a = fromI (lns (const (I x)) a)
	229
	230	-- ... and we need the const functor to implement 'get':
	231	newtype C a b = C { fromC :: a }
	232	instance Functor (C a) where fmap _ (C x) = C x
	233
	234	get :: Lens s t a b -> s -> a
	235	get lns a = fromC (lns C a)
	236
	237	lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
	238	lkp t = fmap snd . F.find (\ (t', _) -> t' == t)
	239
	240	rmv :: NormalizedText -> Seq (Field s) -> Seq (Field s)
	241	rmv n = Seq.filter (\ f -> fieldName f /= n)
	242
	243	-- The & operator is really useful here, but it didn't show up in
	244	-- earlier versions, so it gets redefined here.
	245	#if __GLASGOW_HASKELL__ < 710
	246	{- \| '&' is a reverse application operator. This provides notational
	247	convenience. Its precedence is one higher than that of the
	248	forward application operator '$', which allows '&' to be nested
	249	in '$'. -}
	250	(&) :: a -> (a -> b) -> b
	251	a & f = f a
	252	infixl 1 &
	253	#endif
	254
	255	-- * The 'Ini' type
	256
	257	-- \| An 'Ini' is an abstract representation of an INI file, including
	258	-- both its textual representation and the Haskell value it
	259	-- represents.
	260	data Ini s = Ini
	261	{ iniSpec :: Spec s
	262	, iniCurr :: s
	263	, iniDef :: s
	264	, iniLast :: Maybe RawIni
	265	, iniPol :: UpdatePolicy
	266	}
	267
	268	-- \| Create a basic 'Ini' value from a default value and a spec.
	269	ini :: s -> IniSpec s () -> Ini s
	270	ini def (IniSpec spec) = Ini
	271	{ iniSpec = runBidirM spec
	272	, iniCurr = def
	273	, iniDef = def
	274	, iniLast = Nothing
	275	, iniPol = defaultUpdatePolicy
	276	}
	277
	278	-- \| Get the underlying Haskell value associated with the 'Ini'.
	279	getIniValue :: Ini s -> s
	280	getIniValue = iniCurr
	281
	282	-- \| Get the textual representation of an 'Ini' value. If this 'Ini'
	283	-- value is the result of 'parseIni', then it will attempt to retain
	284	-- the textual characteristics of the parsed version as much as
	285	-- possible (e.g. by retaining comments, ordering, and whitespace in a
	286	-- way that will minimize the overall diff footprint.) If the 'Ini'
	287	-- value was created directly from a value and a specification, then
	288	-- it will pretty-print an initial version of the file with the
	289	-- comments and placeholder text specified in the spec.
	290	serializeIni :: Ini s -> Text
	291	serializeIni = printRawIni . getRawIni
	292
	293	-- \| Get the underlying 'RawIni' value for the file.
	294	getRawIni :: Ini s -> RawIni
	295	getRawIni (Ini { iniLast = Just raw }) = raw
	296	getRawIni (Ini { iniCurr = s
	297	, iniSpec = spec
	298	}) = emitIniFile s spec
	299
	300	-- \| Parse a textual representation of an 'Ini' file. If the file is
	301	-- malformed or if an obligatory field is not found, this will produce
	302	-- a human-readable error message. If an optional field is not found,
	303	-- then it will fall back on the existing value contained in the
	304	-- provided 'Ini' structure.
	305	parseIni :: Text -> Ini s -> Either String (Ini s)
	306	parseIni t i@Ini { iniSpec = spec
	307	, iniCurr = def
	308	} = do
	309	RawIni raw <- parseRawIni t
	310	s <- parseSections def (Seq.viewl spec) raw
	311	return $ i
	312	{ iniCurr = s
	313	, iniLast = Just (RawIni raw)
	314	}
	315
	316	-- \| Update the internal value of an 'Ini' file. If this 'Ini' value
	317	-- is the result of 'parseIni', then the resulting 'Ini' value will
	318	-- attempt to retain the textual characteristics of the parsed version
	319	-- as much as possible (e.g. by retaining comments, ordering, and
	320	-- whitespace in a way that will minimize the overall diff footprint.)
	321	updateIni :: s -> Ini s -> Ini s
	322	updateIni new i =
	323	case doUpdateIni new i of
	324	Left err -> error err
	325	Right i' -> i'
	326
	327	-- \| Use the provided 'UpdatePolicy' as a guide when creating future
	328	-- updated versions of the given 'Ini' value.
	329	setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s
	330	setIniUpdatePolicy pol i = i { iniPol = pol }
	331
	332	-- * Type definitions
	333
	334	-- \| A value of type 'FieldValue' packages up a parser and emitter
	335	-- function into a single value. These are used for bidirectional
	336	-- parsing and emitting of the value of a field.
	337	data FieldValue a = FieldValue
	338	{ fvParse :: Text -> Either String a
	339	-- ^ The function to use when parsing the value of a field; if
	340	-- the parser fails, then the string will be shown as an error
	341	-- message to the user.
	342	, fvEmit :: a -> Text
	343	-- ^ The function to use when serializing a value into an INI
	344	-- file.
	345	}
	346
	347	-- This is actually being used as a writer monad, but using a state
	348	-- monad lets us avoid the space leaks. Not that those are likely to
	349	-- be a problem in this application, but it's not like it cost us
	350	-- none.
	351	type BidirM s a = State (Seq s) a
	352
	353	runBidirM :: BidirM s a -> Seq s
	354	runBidirM = snd . flip runState Seq.empty
	355
	356	type Spec s = Seq (Section s)
	357
	358	-- \| An 'IniSpec' value represents the structure of an entire
	359	-- INI-format file in a declarative way. The @s@ parameter represents
	360	-- the type of a Haskell structure which is being serialized to or
	361	-- from.
	362	newtype IniSpec s a = IniSpec (BidirM (Section s) a)
	363	deriving (Functor, Applicative, Monad)
	364
	365	-- \| A 'SectionSpec' value represents the structure of a single
	366	-- section of an INI-format file in a declarative way. The @s@
	367	-- parameter represents the type of a Haskell structure which is being
	368	-- serialized to or from.
	369	newtype SectionSpec s a = SectionSpec (BidirM (Field s) a)
	370	deriving (Functor, Applicative, Monad)
	371
	372	-- * Sections
	373
	374	-- \| Define the specification of a top-level INI section.
	375	section :: Text -> SectionSpec s () -> IniSpec s ()
	376	section name (SectionSpec mote) = IniSpec $ do
	377	let fields = runBidirM mote
	378	modify (Seq.\|> Section (normalize name) fields (allFieldsOptional fields))
	379
	380	allFieldsOptional :: (Seq (Field s)) -> Bool
	381	allFieldsOptional = all isOptional
	382	where isOptional (Field _ fd) = fdSkipIfMissing fd
	383	isOptional (FieldMb _ _) = True
	384
	385	-- \| Treat an entire section as containing entirely optional fields.
	386	allOptional
	387	:: (SectionSpec s () -> IniSpec s ())
	388	-> (SectionSpec s () -> IniSpec s ())
	389	allOptional k spec = IniSpec $ do
	390	let IniSpec comp = k spec
	391	comp
	392	modify (\ s -> case Seq.viewr s of
	393	EmptyR -> s
	394	rs :> Section name fields _ ->
	395	rs Seq.\|> Section name (fmap makeOptional fields) True)
	396
	397	makeOptional :: Field s -> Field s
	398	makeOptional (Field l d) = Field l d { fdSkipIfMissing = True }
	399	makeOptional (FieldMb l d) = FieldMb l d { fdSkipIfMissing = True }
	400
	401	data Section s = Section NormalizedText (Seq (Field s)) Bool
	402
	403	-- * Fields
	404
	405	-- \| A "Field" is a description of
	406	data Field s
	407	= forall a. Eq a => Field (Lens s s a a) (FieldDescription a)
	408	\| forall a. Eq a => FieldMb (Lens s s (Maybe a) (Maybe a)) (FieldDescription a)
	409
	410	-- convenience accessors for things in a Field
	411	fieldName :: Field s -> NormalizedText
	412	fieldName (Field _ FieldDescription { fdName = n }) = n
	413	fieldName (FieldMb _ FieldDescription { fdName = n }) = n
	414
	415	fieldComment :: Field s -> Seq Text
	416	fieldComment (Field _ FieldDescription { fdComment = n }) = n
	417	fieldComment (FieldMb _ FieldDescription { fdComment = n }) = n
	418
	419	-- \| A 'FieldDescription' is a declarative representation of the
	420	-- structure of a field. This includes the name of the field and the
	421	-- 'FieldValue' used to parse and serialize values of that field, as
	422	-- well as other metadata that might be needed in the course of
	423	-- parsing or serializing a structure.
	424	data FieldDescription t = FieldDescription
	425	{ fdName :: NormalizedText
	426	, fdValue :: FieldValue t
	427	, fdComment :: Seq Text
	428	, fdDummy :: Maybe Text
	429	, fdSkipIfMissing :: Bool
	430	}
	431
	432	-- ** Field operators
	433
	434	{- \|
	435	Associate a field description with a field. If this field
	436	is not present when parsing, it will attempt to fall back
	437	on a default, and if no default value is present, it will
	438	fail to parse.
	439
	440	When serializing an INI file, this will produce all the
	441	comments associated with the field description followed
	442	by the value of the field in the.
	443	-}
	444	(.=) :: Eq t => Lens s s t t -> FieldDescription t -> SectionSpec s ()
	445	l .= f = SectionSpec $ modify (Seq.\|> fd)
	446	where fd = Field l f
	447
	448	{- \|
	449	Associate a field description with a field of type "Maybe a".
	450	When parsing, this field will be initialized to "Nothing" if
	451	it is not found, and to a "Just" value if it is. When
	452	serializing an INI file, this will try to serialize a value
	453	-}
	454	(.=?) :: Eq t => Lens s s (Maybe t) (Maybe t) -> FieldDescription t -> SectionSpec s ()
	455	l .=? f = SectionSpec $ modify (Seq.\|> fd)
	456	where fd = FieldMb l f
	457
	458	-- ** Field metadata
	459
	460	{- \|
	461	Associate a multiline comment with a "FieldDescription". When
	462	serializing a field that has a comment associated, the comment will
	463	appear before the field.
	464	-}
	465	comment :: [Text] -> FieldDescription t -> FieldDescription t
	466	comment cmt fd = fd { fdComment = Seq.fromList cmt }
	467
	468	-- \| Choose a placeholder value to be displayed for optional fields.
	469	-- This is used when serializing an optional Ini field: the
	470	-- field will appear commented out in the output using the
	471	-- placeholder text as a value, so a spec that includes
	472	--
	473	-- @
	474	-- myLens .=? field "x" & placeholderValue "<val>"
	475	-- @
	476	--
	477	-- will serialize into an INI file that contains the line
	478	--
	479	-- @
	480	-- # x = <val>
	481	-- @
	482	--
	483	-- A placeholder value will only appear in the serialized output
	484	-- if the field is optional, but will be preferred over serializing
	485	-- a "defaultValue". If a "placeholderValue" is not
	486	placeholderValue :: Text -> FieldDescription t -> FieldDescription t
	487	placeholderValue t fd = fd { fdDummy = Just t }
	488
	489	-- \| If the field is not found in parsing, simply skip instead of
	490	-- raising an error or setting anything.
	491	optional :: FieldDescription t -> FieldDescription t
	492	optional fd = fd { fdSkipIfMissing = True }
	493
	494	infixr 0 .=
	495	infixr 0 .=?
	496
	497	-- ** Creating fields
	498
	499	-- \| Create a description of a field by a combination of the name of
	500	-- the field and a "FieldValue" describing how to parse and emit
	501	-- values associated with that field.
	502	field :: Text -> FieldValue a -> FieldDescription a
	503	field name value = FieldDescription
	504	{ fdName = normalize (name <> " ")
	505	, fdValue = value
	506	, fdComment = Seq.empty
	507	, fdDummy = Nothing
	508	, fdSkipIfMissing = False
	509	}
	510
	511	-- \| Create a description of a 'Bool'-valued field.
	512	flag :: Text -> FieldDescription Bool
	513	flag name = field name bool
	514
	515	-- ** FieldValues
	516
	517	-- \| A "FieldValue" for parsing and serializing values according to
	518	-- the logic of the "Read" and "Show" instances for that type,
	519	-- providing a convenient human-readable error message if the
	520	-- parsing step fails.
	521	readable :: forall a. (Show a, Read a, Typeable a) => FieldValue a
	522	readable = FieldValue { fvParse = parse, fvEmit = emit }
	523	where emit = T.pack . show
	524	parse t = case readMaybe (T.unpack t) of
	525	Just v -> Right v
	526	Nothing -> Left ("Unable to parse " ++ show t ++
	527	" as a value of type " ++ show typ)
	528	typ = typeRep (prx)
	529	prx :: Proxy a
	530	prx = Proxy
	531
	532	-- \| Represents a numeric field whose value is parsed according to the
	533	-- 'Read' implementation for that type, and is serialized according to
	534	-- the 'Show' implementation for that type.
	535	number :: (Show a, Read a, Num a, Typeable a) => FieldValue a
	536	number = readable
	537
	538	-- \| Represents a field whose value is a 'Text' value
	539	text :: FieldValue Text
	540	text = FieldValue { fvParse = Right, fvEmit = id }
	541
	542	-- \| Represents a field whose value is a 'String' value
	543	string :: FieldValue String
	544	string = FieldValue { fvParse = Right . T.unpack, fvEmit = T.pack }
	545
	546	-- \| Represents a field whose value is a 'Bool' value. This parser is
	547	-- case-insensitive, and matches the words @true@, @false@, @yes@, and
	548	-- @no@, as well as single-letter abbreviations for all of the
	549	-- above. This will serialize as @true@ for 'True' and @false@ for
	550	-- 'False'.
	551	bool :: FieldValue Bool
	552	bool = FieldValue { fvParse = parse, fvEmit = emit }
	553	where parse s = case T.toLower s of
	554	"true" -> Right True
	555	"yes" -> Right True
	556	"t" -> Right True
	557	"y" -> Right True
	558	"false" -> Right False
	559	"no" -> Right False
	560	"f" -> Right False
	561	"n" -> Right False
	562	_ -> Left ("Unable to parse " ++ show s ++ " as a boolean")
	563	emit True = "true"
	564	emit False = "false"
	565
	566	-- \| Represents a field whose value is a sequence of other values
	567	-- which are delimited by a given string, and whose individual values
	568	-- are described by another 'FieldValue' value. This uses GHC's
	569	-- `IsList` typeclass to convert back and forth between sequence
	570	-- types.
	571	listWithSeparator :: IsList l => Text -> FieldValue (Item l) -> FieldValue l
	572	listWithSeparator sep fv = FieldValue
	573	{ fvParse = fmap fromList . mapM (fvParse fv . T.strip) . T.splitOn sep
	574	, fvEmit = T.intercalate sep . map (fvEmit fv) . toList
	575	}
	576
	577	-- \| Represents a field whose value is a pair of two other values
	578	-- separated by a given string, whose individual values are described
	579	-- by two different 'FieldValue' values.
	580	pairWithSeparator :: FieldValue l -> Text -> FieldValue r -> FieldValue (l, r)
	581	pairWithSeparator left sep right = FieldValue
	582	{ fvParse = \ t ->
	583	let (leftChunk, rightChunk) = T.breakOn sep t
	584	in do
	585	x <- fvParse left leftChunk
	586	y <- fvParse right rightChunk
	587	return (x, y)
	588	, fvEmit = \ (x, y) -> fvEmit left x <> sep <> fvEmit right y
	589	}
	590
	591	-- * Parsing INI files
	592
	593	-- Are you reading this source code? It's not even that gross
	594	-- yet. Just you wait. This is just the regular part. 'runSpec' is
	595	-- easy: we walk the spec, and for each section, find the
	596	-- corresponding section in the INI file and call runFields.
	597	parseSections
	598	:: s
	599	-> Seq.ViewL (Section s)
	600	-> Seq (NormalizedText, IniSection)
	601	-> Either String s
	602	parseSections s Seq.EmptyL _ = Right s
	603	parseSections s (Section name fs opt Seq.:< rest) i
	604	\| Just v <- lkp name i = do
	605	s' <- parseFields s (Seq.viewl fs) v
	606	parseSections s' (Seq.viewl rest) i
	607	\| opt = parseSections s (Seq.viewl rest) i
	608	\| otherwise = Left ("Unable to find section " ++
	609	show (normalizedText name))
	610
	611	-- Now that we've got 'set', we can walk the field descriptions and
	612	-- find them. There's some fiddly logic, but the high-level idea is
	613	-- that we try to look up a field, and if it exists, parse it using
	614	-- the provided parser and use the provided lens to add it to the
	615	-- value. We have to decide what to do if it's not there, which
	616	-- depends on lens metadata and whether it's an optional field or not.
	617	parseFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s
	618	parseFields s Seq.EmptyL _ = Right s
	619	parseFields s (Field l descr Seq.:< fs) sect
	620	\| Just v <- lkp (fdName descr) (isVals sect) = do
	621	value <- fvParse (fdValue descr) (T.strip (vValue v))
	622	parseFields (set l value s) (Seq.viewl fs) sect
	623	\| fdSkipIfMissing descr =
	624	parseFields s (Seq.viewl fs) sect
	625	\| otherwise = Left ("Unable to find field " ++
	626	show (normalizedText (fdName descr)))
	627	parseFields s (FieldMb l descr Seq.:< fs) sect
	628	\| Just v <- lkp (fdName descr) (isVals sect) = do
	629	value <- fvParse (fdValue descr) (T.strip (vValue v))
	630	parseFields (set l (Just value) s) (Seq.viewl fs) sect
	631	\| otherwise =
	632	parseFields (set l Nothing s) (Seq.viewl fs) sect
	633
	634	-- \| Serialize a value as an INI file according to a provided
	635	-- 'IniSpec'.
	636	emitIniFile :: s -> Spec s -> RawIni
	637	emitIniFile s spec =
	638	RawIni $
	639	fmap (\ (Section name fs _) ->
	640	(name, toSection s (actualText name) fs)) spec
	641
	642	mkComments :: Seq Text -> Seq BlankLine
	643	mkComments comments =
	644	fmap (\ ln -> CommentLine '#' (" " <> ln)) comments
	645
	646	toSection :: s -> Text -> Seq (Field s) -> IniSection
	647	toSection s name fs = IniSection
	648	{ isName = name
	649	, isVals = fmap toVal fs
	650	, isStartLine = 0
	651	, isEndLine = 0
	652	, isComments = Seq.empty
	653	} where mkIniValue val descr opt =
	654	( fdName descr
	655	, IniValue
	656	{ vLineNo = 0
	657	, vName = actualText (fdName descr)
	658	, vValue = " " <> val
	659	, vComments = mkComments (fdComment descr)
	660	, vCommentedOut = opt
	661	, vDelimiter = '='
	662	}
	663	)
	664	toVal (Field l descr)
	665	\| Just dummy <- fdDummy descr =
	666	mkIniValue dummy descr False
	667	\| otherwise =
	668	mkIniValue (fvEmit (fdValue descr) (get l s)) descr False
	669	toVal (FieldMb l descr)
	670	\| Just dummy <- fdDummy descr =
	671	mkIniValue dummy descr True
	672	\| Just v <- get l s =
	673	mkIniValue (fvEmit (fdValue descr) v) descr True
	674	\| otherwise =
	675	mkIniValue "" descr True
	676
	677	-- \| An 'UpdatePolicy' guides certain choices made when an 'Ini' file
	678	-- is updated: for example, how to add comments to the generated
	679	-- fields, or how to treat fields which are optional.
	680	data UpdatePolicy = UpdatePolicy
	681	{ updateAddOptionalFields :: Bool
	682	-- ^ If 'True', then optional fields not included in the INI file
	683	-- will be included in the updated INI file. Defaults to 'False'.
	684	, updateIgnoreExtraneousFields :: Bool
	685	-- ^ If 'True', then fields in the INI file that have no
	686	-- corresponding description in the 'IniSpec' will be ignored; if
	687	-- 'False', then those fields will return an error value. Defaults
	688	-- to 'True'.
	689	, updateGeneratedCommentPolicy :: UpdateCommentPolicy
	690	-- ^ The policy for what to do to comments associated with
	691	-- modified fields during an update. Defaults to
	692	-- 'CommentPolicyNone'.
	693	} deriving (Eq, Show)
	694
	695	-- \| A set of sensible 'UpdatePolicy' defaults which keep the diffs
	696	-- between file versions minimal.
	697	defaultUpdatePolicy :: UpdatePolicy
	698	defaultUpdatePolicy = UpdatePolicy
	699	{ updateAddOptionalFields = False
	700	, updateIgnoreExtraneousFields = True
	701	, updateGeneratedCommentPolicy = CommentPolicyNone
	702	}
	703
	704	-- \| An 'UpdateCommentPolicy' describes what comments should accompany
	705	-- a field added to or modified in an existing INI file when using
	706	-- 'updateIni'.
	707	data UpdateCommentPolicy
	708	= CommentPolicyNone
	709	-- ^ Do not add comments to new fields
	710	\| CommentPolicyAddFieldComment
	711	-- ^ Add the same comment which appears in the 'IniSpec' value for
	712	-- the field we're adding or modifying.
	713	\| CommentPolicyAddDefaultComment (Seq Text)
	714	-- ^ Add a common comment to all new fields added or modified
	715	-- by an 'updateIni' call.
	716	deriving (Eq, Show)
	717
	718	getComments :: FieldDescription s -> UpdateCommentPolicy -> (Seq BlankLine)
	719	getComments _ CommentPolicyNone = Seq.empty
	720	getComments f CommentPolicyAddFieldComment =
	721	mkComments (fdComment f)
	722	getComments _ (CommentPolicyAddDefaultComment cs) =
	723	mkComments cs
	724
	725	-- \| Given a value, an 'IniSpec', and a 'Text' form of an INI file,
	726	-- parse 'Text' as INI and then selectively modify the file whenever
	727	-- the provided value differs from the file. This is designed to help
	728	-- applications update a user's configuration automatically while
	729	-- retaining the structure and comments of a user's application,
	730	-- ideally in a way which produces as few changes as possible to the
	731	-- resulting file (so that, for example, the diff between the two
	732	-- should be as small as possible.)
	733	--
	734	-- A field is considered to have "changed" if the parsed
	735	-- representation of the field as extracted from the textual INI file
	736	-- is not equal to the corresponding value in the provided
	737	-- structure. Changed fields will retain their place in the overall
	738	-- file, while newly added fields (for example, fields which have
	739	-- been changed from a default value) will be added to the end of the
	740	-- section in which they appear.
	741	--doUpdateIni :: s -> s -> Spec s -> RawIni -> UpdatePolicy -> Either String (Ini s)
	742	doUpdateIni :: s -> Ini s -> Either String (Ini s)
	743	doUpdateIni s i@Ini { iniSpec = spec
	744	, iniDef = def
	745	, iniPol = pol
	746	} = do -- spec (RawIni ini) pol = do
	747	let RawIni ini' = getRawIni i
	748	res <- updateSections s def ini' spec pol
	749	return $ i
	750	{ iniCurr = s
	751	, iniLast = Just (RawIni res)
	752	}
	753
	754	updateSections
	755	:: s
	756	-> s
	757	-> Seq (NormalizedText, IniSection)
	758	-> Seq (Section s)
	759	-> UpdatePolicy
	760	-> Either String (Seq (NormalizedText, IniSection))
	761	updateSections s def sections fields pol = do
	762	-- First, we process all the sections that actually appear in the
	763	-- INI file in order
	764	existingSections <- F.for sections $ \ (name, sec) -> do
	765	let err = Left ("Unexpected top-level section: " ++ show name)
	766	Section _ spec _ <- maybe err Right
	767	(F.find (\ (Section n _ _) -> n == name) fields)
	768	newVals <- updateFields s (isVals sec) spec pol
	769	return (name, sec { isVals = newVals })
	770	-- And then
	771	let existingSectionNames = fmap fst existingSections
	772	newSections <- F.for fields $
	773	\ (Section nm spec _) ->
	774	if \| nm `elem` existingSectionNames -> return mempty
	775	\| otherwise ->
	776	let rs = emitNewFields s def spec pol
	777	in if Seq.null rs
	778	then return mempty
	779	else return $ Seq.singleton
	780	( nm
	781	, IniSection (actualText nm) rs 0 0 mempty
	782	)
	783	return (existingSections <> F.asum newSections)
	784
	785	-- We won't emit a section if everything in the section is also
	786	-- missing
	787	emitNewFields
	788	:: s -> s
	789	-> Seq (Field s)
	790	-> UpdatePolicy ->
	791	Seq (NormalizedText, IniValue)
	792	emitNewFields s def fields pol = go (Seq.viewl fields) where
	793	go EmptyL = Seq.empty
	794	go (Field l d :< fs)
	795	-- If a field is not present but is also the same as the default,
	796	-- then we can safely omit it
	797	\| get l s == get l def && not (updateAddOptionalFields pol) =
	798	go (Seq.viewl fs)
	799	-- otherwise, we should add it to the result
	800	\| otherwise =
	801	let cs = getComments d (updateGeneratedCommentPolicy pol)
	802	new = ( fdName d
	803	, IniValue
	804	{ vLineNo = 0
	805	, vName = actualText (fdName d)
	806	, vValue = " " <> fvEmit (fdValue d) (get l s)
	807	, vComments = cs
	808	, vCommentedOut = False
	809	, vDelimiter = '='
	810	}
	811	)
	812	in new <\| go (Seq.viewl fs)
	813	go (FieldMb l d :< fs) =
	814	case get l s of
	815	Nothing -> go (Seq.viewl fs)
	816	Just v ->
	817	let cs = getComments d (updateGeneratedCommentPolicy pol)
	818	new = ( fdName d
	819	, IniValue
	820	{ vLineNo = 0
	821	, vName = actualText (fdName d)
	822	, vValue = fvEmit (fdValue d) v
	823	, vComments = cs
	824	, vCommentedOut = False
	825	, vDelimiter = '='
	826	}
	827	)
	828	in new <\| go (Seq.viewl fs)
	829
	830
	831	updateFields :: s -> Seq (NormalizedText, IniValue) -> Seq (Field s)
	832	-> UpdatePolicy -> Either String (Seq (NormalizedText, IniValue))
	833	updateFields s values fields pol = go (Seq.viewl values) fields
	834	where go ((t, val) :< vs) fs =
	835	-- For each field, we need to fetch the description of the
	836	-- field in the spec
	837	case F.find (\ f -> fieldName f == t) fs of
	838	Just f@(Field l descr) ->
	839	-- if it does exist, then we need to find out whether
	840	-- the field has changed at all. We can do this with the
	841	-- provided lens, and check it against the INI file
	842	-- we've got. There's a minor complication: there's
	843	-- nothing that forces the user to provide the same INI
	844	-- file we originally parsed! One side-effect means that
	845	-- the parsed INI file might not actually have a valid
	846	-- field according to the field parser the user
	847	-- provides. In that case, we'll assume the field is
	848	-- outdated, and update it with the value in the
	849	-- provided structure.
	850	if Right (get l s) == fvParse (fdValue descr) (T.strip (vValue val))
	851	-- if the value in the INI file parses the same as
	852	-- the one in the structure we were passed, then it
	853	-- doesn't need any updating, and we keep going,
	854	-- removing the field from our list
	855	then ((t, val) <\|) `fmap` go (Seq.viewl vs) (rmv t fs)
	856	-- otherwise, we've got a new updated value! Let's
	857	-- synthesize a new element, using our comment policy
	858	-- to comment it accordingly. (This pattern is
	859	-- partial, but we should never have a situation
	860	-- where it returns Nothing, because we already know
	861	-- that we've matched a Field!)
	862	else let Just nv = mkValue t f (vDelimiter val)
	863	in ((t, nv) <\|) `fmap` go (Seq.viewl vs) (rmv t fs)
	864	-- And we have to replicate the logic for the FieldMb
	865	-- case, because (as an existential) it doesn't really
	866	-- permit us usable abstractions here. See the previous
	867	-- comments for descriptions of the cases.
	868	Just f@(FieldMb l descr) ->
	869	let parsed = fvParse (fdValue descr) (T.strip (vValue val))
	870	in if Right (get l s) == fmap Just parsed
	871	then ((t, val) <\|) `fmap` go (Seq.viewl vs) (rmv t fs)
	872	-- this is in the only case where the FieldMb case
	873	-- differs: we might NOT have a value in the
	874	-- structure. In that case, we remove the value
	875	-- from the file, as well!
	876	else case mkValue t f (vDelimiter val) of
	877	Just nv -> ((t, nv) <\|) `fmap` go (Seq.viewl vs) (rmv t fs)
	878	Nothing -> go (Seq.viewl vs) (rmv t fs)
	879	-- Finally, if we can't find any description of the field,
	880	-- then we might skip it or throw an error, depending on
	881	-- the policy the user wants.
	882	Nothing
	883	\| updateIgnoreExtraneousFields pol ->
	884	((t, val) <\|) `fmap` go (Seq.viewl vs) fs
	885	\| otherwise -> Left ("Unexpected field: " ++ show t)
	886	-- Once we've gone through all the fields in the file, we need
	887	-- to see if there's anything left over that should be in the
	888	-- file. We might want to include dummy values for things that
	889	-- were left out, but if we have any non-optional fields left
	890	-- over, then we definitely need to include them.
	891	go EmptyL fs = return (finish (Seq.viewl fs))
	892	finish (f@(Field {}) :< fs)
	893	\| updateAddOptionalFields pol
	894	, Just val <- mkValue (fieldName f) f '=' =
	895	(fieldName f, val) <\| finish (Seq.viewl fs)
	896	\| otherwise = finish (Seq.viewl fs)
	897	finish (f@(FieldMb _ descr) :< fs)
	898	\| not (fdSkipIfMissing descr)
	899	, Just val <- mkValue (fieldName f) f '=' =
	900	(fieldName f, val) <\| finish (Seq.viewl fs)
	901	\| updateAddOptionalFields pol
	902	, Just val <- mkValue (fieldName f) f '=' =
	903	(fieldName f, val) <\| finish (Seq.viewl fs)
	904	\| otherwise = finish (Seq.viewl fs)
	905	-- If there's nothing left, then we can return a final value!
	906	finish EmptyL = Seq.empty
	907	mkValue t fld delim =
	908	let comments = case updateGeneratedCommentPolicy pol of
	909	CommentPolicyNone -> Seq.empty
	910	CommentPolicyAddFieldComment ->
	911	mkComments (fieldComment fld)
	912	CommentPolicyAddDefaultComment cs ->
	913	mkComments cs
	914	val = IniValue
	915	{ vLineNo = 0
	916	, vName = actualText t
	917	, vValue = ""
	918	, vComments = comments
	919	, vCommentedOut = False
	920	, vDelimiter = delim
	921	}
	922	in case fld of
	923	Field l descr ->
	924	Just (val { vValue = " " <> fvEmit (fdValue descr) (get l s) })
	925	FieldMb l descr ->
	926	case get l s of
	927	Just v -> Just (val { vValue = " " <> fvEmit (fdValue descr) v })
	928	Nothing -> Nothing
	929
	930
	931	-- $using
	932	-- Functions for parsing, serializing, and updating INI files.
	933
	934	-- $types
	935	-- Types which represent declarative specifications for INI
	936	-- file structure.
	937
	938	-- $sections
	939	-- Declaring sections of an INI file specification
	940
	941	-- $fields
	942	-- Declaring individual fields of an INI file specification.
	943
	944	-- $fieldvalues
	945	-- Values of type 'FieldValue' represent both a parser and a
	946	-- serializer for a value of a given type. It's possible to manually
	947	-- create 'FieldValue' descriptions, but for simple configurations,
	948	-- but for the sake of convenience, several commonly-needed
	949	-- varieties of 'FieldValue' are defined here.
	950
	951	-- $misc
	952	-- These values and types are exported for compatibility.

-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.

+241

-55

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

	1	{-\|
	2	Module : Data.Ini.Config.Raw
	3	Copyright : (c) Getty Ritter, 2017
	4	License : BSD
	5	Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
	6	Stability : experimental
	7
	8	__Warning!__ This module is subject to change in the future, and therefore should
	9	not be relied upon to have a consistent API.
	10
	11	-}
1	12	module Data.Ini.Config.Raw
2		( ~~Ini(..)~~
	13	( -- * INI types
	14	RawIni(..)
3	15	, IniSection(..)
4	16	, IniValue(..)
5		, ~~parseIni~~
	17	, BlankLine(..)
	18	, NormalizedText(..)
	19	, normalize
	20	-- * serializing and deserializing
	21	, parseRawIni
	22	, printRawIni
	23	-- * inspection
	24	, lookupInSection
	25	, lookupSection
	26	, lookupValue
6	27	) where
7	28
8	29	import Control.Monad (void)
9		import Data.HashMap.Strict (HashMap)
10		import qualified Data.HashMap.Strict as HM
	30	import qualified Data.Foldable as F
	31	import Data.Monoid ((<>))
	32	import Data.Sequence (Seq)
	33	import qualified Data.Sequence as Seq
11	34	import Data.Text (Text)
12	35	import qualified Data.Text as T
	36	import qualified Data.Text.Lazy as LazyText
	37	import qualified Data.Text.Lazy.Builder as Builder
	38	import Data.Void (Void)
13	39	import Text.Megaparsec
14		import Text.Megaparsec.~~Text~~
	40	import Text.Megaparsec.Char
	41
	42	type Parser = Parsec (ErrorFancy Void) Text
	43
	44	-- \| The 'NormalizedText' type is an abstract representation of text
	45	-- which has had leading and trailing whitespace removed and been
	46	-- normalized to lower-case, but from which we can still extract the
	47	-- original, non-normalized version. This acts like the normalized
	48	-- text for the purposes of 'Eq' and 'Ord' operations, so
	49	--
	50	-- @
	51	-- 'normalize' " x " == 'normalize' \"X\"
	52	-- @
	53	--
	54	-- This type is used to store section and key names in the
	55	data NormalizedText = NormalizedText
	56	{ actualText :: Text
	57	, normalizedText :: Text
	58	} deriving (Show)
	59
	60	-- \| The constructor function to build a 'NormalizedText' value. You
	61	-- probably shouldn't be using this module directly, but if for some
	62	-- reason you are using it, then you should be using this function to
	63	-- create 'NormalizedText' values.
	64	normalize :: Text -> NormalizedText
	65	normalize t = NormalizedText t (T.toLower (T.strip t))
	66
	67	instance Eq NormalizedText where
	68	NormalizedText _ x == NormalizedText _ y =
	69	x == y
	70
	71	instance Ord NormalizedText where
	72	NormalizedText _ x `compare` NormalizedText _ y =
	73	x `compare` y
15	74
16	75	-- \| An 'Ini' value is a mapping from section names to
17		-- 'IniSection' values.
18		newtype Ini
19		= Ini { fromIni :: HashMap Text IniSection }
20		deriving (Eq, Show)
	76	-- 'IniSection' values. The section names in this mapping are
	77	-- normalized to lower-case and stripped of whitespace. This
	78	-- sequence retains the ordering of the original source file.
	79	newtype RawIni = RawIni
	80	{ fromRawIni :: Seq (NormalizedText, IniSection)
	81	} deriving (Eq, Show)
21	82
22	83	-- \| An 'IniSection' consists of a name, a mapping of key-value pairs,
23		-- and metadata about where the section starts and ends in the ~~file.~~
	84	-- and metadata about where the section starts and ends in the
	85	-- file. The section names found in 'isName' are __not__ normalized
	86	-- to lower-case or stripped of whitespace, and thus should appear
	87	-- exactly as they appear in the original source file.
24	88	data IniSection = IniSection
25	89	{ isName :: Text
26		~~, isVals :: HashMap Text IniValu~~e
	90	-- ^ The name of the section, as it appears in the
	91	-- original INI source
	92	, isVals :: Seq (NormalizedText, IniValue)
	93	-- ^ The key-value mapping within that section. Key
	94	-- names here are normalized to lower-case and
	95	-- stripped of whitespace. This sequence retains
	96	-- the ordering of the original source file.
27	97	, isStartLine :: Int
	98	-- ^ The line on which the section begins. This
	99	-- field is ignored when serializing, and is only
	100	-- used for error messages produced when parsing
	101	-- and deserializing an INI structure.
28	102	, isEndLine :: Int
	103	-- ^ The line on which the section ends. This field
	104	-- is ignored when serializing, and is only used
	105	-- for error messages produced when parsing and
	106	-- deserializing an INI structure.
	107	, isComments :: Seq BlankLine
	108	-- ^ The blank lines and comments that appear prior
	109	-- to the section head declaration, retained for
	110	-- pretty-printing identical INI files.
29	111	} deriving (Eq, Show)
30	112
31	113	-- \| An 'IniValue' represents a key-value mapping, and also stores the
32		-- line number where it appears.
	114	-- line number where it appears. The key names and values found in
	115	-- 'vName' and 'vValue' respectively are _not_ normalized to
	116	-- lower-case or stripped of whitespace, and thus should appear
	117	-- exactly as they appear in the original source file.
33	118	data IniValue = IniValue
34		{ vLineNo :: Int
35		, vName :: Text
36		~~, vValue :: Tex~~t
	119	{ vLineNo :: Int
	120	-- ^ The line on which the key/value mapping
	121	-- appears. This field is ignored when
	122	-- serializing, and is only used for error
	123	-- messages produced when parsing and
	124	-- deserializing an INI structure.
	125	, vName :: Text
	126	-- ^ The name of the key, as it appears in the INI source.
	127	, vValue :: Text
	128	-- ^ The value of the key
	129	, vComments :: Seq BlankLine
	130	, vCommentedOut :: Bool
	131	-- ^ Right now, this will never show up in a parsed INI file, but
	132	-- it's used when emitting a default INI file: it causes the
	133	-- key-value line to include a leading comment as well.
	134	, vDelimiter :: Char
37	135	} deriving (Eq, Show)
38	136
39		-- \| Parse a 'Text' value into an 'Ini' value.
40		parseIni :: Text -> Either String Ini
41		parseIni t = case runParser pIni "ini file" t of
	137	-- \| We want to keep track of the whitespace/comments in between KV
	138	-- lines, so this allows us to track those lines in a reproducible
	139	-- way.
	140	data BlankLine
	141	= CommentLine Char Text
	142	\| BlankLine
	143	deriving (Eq, Show)
	144
	145	-- \| Parse a 'Text' value into an 'Ini' value, retaining a maximal
	146	-- amount of structure as needed to reconstruct the original INI file.
	147	parseRawIni :: Text -> Either String RawIni
	148	parseRawIni t = case runParser pIni "ini file" t of
42	149	Left err -> Left (parseErrorPretty err)
43	150	Right v -> Right v
44	151
45		pIni :: Parser Ini
	152	pIni :: Parser RawIni
46	153	pIni = do
47		sBlanks
48		vs <- many (pSection <?> "section")
49		void eof
50		return $ Ini $ HM.fromList [ (T.toLower (isName v), v)
51		\| v <- vs
52		]
53
54		sBlanks :: Parser ()
55		sBlanks = skipMany (void eol <\|> sComment)
56
57		sComment :: Parser ()
	154	leading <- sBlanks
	155	pSections leading Seq.empty
	156
	157	sBlanks :: Parser (Seq BlankLine)
	158	sBlanks = Seq.fromList <$> many ((BlankLine <$ void eol) <\|> sComment)
	159
	160	sComment :: Parser BlankLine
58	161	sComment = do
59		void (oneOf ";#")
60		void (manyTill anyChar eol)
61
62		pSection :: Parser IniSection
63		pSection = do
	162	c <- oneOf ";#"
	163	txt <- T.pack `fmap` manyTill anyChar eol
	164	return (CommentLine c txt)
	165
	166	pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
	167	pSections leading prevs =
	168	pSection leading prevs <\|> (RawIni prevs <$ void eof)
	169
	170	pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
	171	pSection leading prevs = do
64	172	start <- getCurrentLine
65	173	void (char '[')
66	174	name <- T.pack `fmap` some (noneOf "[]")
67	175	void (char ']')
68		sBlanks
69		vals <- many (pPair <?> "key-value pair")
70		end <- getCurrentLine
71		sBlanks
72		return IniSection
73		{ isName = T.strip name
74		, isVals = HM.fromList [ (vName v, v) \| v <- vals ]
75		, isStartLine = start
76		, isEndLine = end
77		}
78
79		pPair :: Parser IniValue
80		pPair = do
	176	void eol
	177	comments <- sBlanks
	178	pPairs (T.strip name) start leading prevs comments Seq.empty
	179
	180	pPairs :: Text
	181	-> Int
	182	-> Seq BlankLine
	183	-> Seq (NormalizedText, IniSection)
	184	-> Seq BlankLine
	185	-> Seq (NormalizedText, IniValue)
	186	-> Parser RawIni
	187	pPairs name start leading prevs comments pairs = newPair <\|> finishedSection
	188	where
	189	newPair = do
	190	(n, pair) <- pPair comments
	191	rs <- sBlanks
	192	pPairs name start leading prevs rs (pairs Seq.\|> (n, pair))
	193	finishedSection = do
	194	end <- getCurrentLine
	195	let newSection = IniSection
	196	{ isName = name
	197	, isVals = pairs
	198	, isStartLine = start
	199	, isEndLine = end
	200	, isComments = leading
	201	}
	202	pSections comments (prevs Seq.\|> (normalize name, newSection))
	203
	204	pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)
	205	pPair leading = do
81	206	pos <- getCurrentLine
82	207	key <- T.pack `fmap` some (noneOf "[]=:")
83		~~void (oneOf ":=")~~
	208	delim <- oneOf ":="
84	209	val <- T.pack `fmap` manyTill anyChar eol
85		sBlanks
86		return IniValue
87		{ vLineNo = pos
88		, vName = T.strip key
89		, vValue = T.strip val
90		}
	210	return ( normalize key
	211	, IniValue
	212	{ vLineNo = pos
	213	, vName = key
	214	, vValue = val
	215	, vComments = leading
	216	, vCommentedOut = False
	217	, vDelimiter = delim
	218	} )
91	219
92	220	getCurrentLine :: Parser Int
93	221	getCurrentLine = (fromIntegral . unPos . sourceLine) `fmap` getPosition
	222
	223
	224	-- \| Serialize an INI file to text, complete with any comments which
	225	-- appear in the INI structure, and retaining the aesthetic details
	226	-- which are present in the INI file.
	227	printRawIni :: RawIni -> Text
	228	printRawIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromRawIni
	229	where
	230	build (_, ini) =
	231	F.foldMap buildComment (isComments ini) <>
	232	Builder.singleton '[' <>
	233	Builder.fromText (isName ini) <>
	234	Builder.fromString "]\n" <>
	235	F.foldMap buildKV (isVals ini)
	236	buildComment BlankLine = Builder.singleton '\n'
	237	buildComment (CommentLine c txt) =
	238	Builder.singleton c <> Builder.fromText txt <> Builder.singleton '\n'
	239	buildKV (_, val) =
	240	F.foldMap buildComment (vComments val) <>
	241	(if vCommentedOut val then Builder.fromString "# " else mempty) <>
	242	Builder.fromText (vName val) <>
	243	Builder.singleton (vDelimiter val) <>
	244	Builder.fromText (vValue val) <>
	245	Builder.singleton '\n'
	246
	247	-- \| Look up an Ini value by section name and key. Returns the sequence
	248	-- of matches.
	249	lookupInSection :: Text
	250	-- ^ The section name. Will be normalized prior to
	251	-- comparison.
	252	-> Text
	253	-- ^ The key. Will be normalized prior to comparison.
	254	-> RawIni
	255	-- ^ The Ini to search.
	256	-> Seq.Seq Text
	257	lookupInSection sec opt ini =
	258	vValue <$> (F.asum (lookupValue opt <$> lookupSection sec ini))
	259
	260	-- \| Look up an Ini section by name. Returns a sequence of all matching
	261	-- section records.
	262	lookupSection :: Text
	263	-- ^ The section name. Will be normalized prior to
	264	-- comparison.
	265	-> RawIni
	266	-- ^ The Ini to search.
	267	-> Seq.Seq IniSection
	268	lookupSection name ini =
	269	snd <$> (Seq.filter ((== normalize name) . fst) $ fromRawIni ini)
	270
	271	-- \| Look up an Ini key's value in a given section by the key. Returns
	272	-- the sequence of matches.
	273	lookupValue :: Text
	274	-- ^ The key. Will be normalized prior to comparison.
	275	-> IniSection
	276	-- ^ The section to search.
	277	-> Seq.Seq IniValue
	278	lookupValue name section =
	279	snd <$> Seq.filter ((== normalize name) . fst) (isVals section)

+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.

+109

-68

src/Data/Ini/Config.hs less more

	1	{-\|
	2	Module : Data.Ini.Config
	3	Copyright : (c) Getty Ritter, 2017
	4	License : BSD
	5	Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
	6	Stability : experimental
	7
	8	The 'config-ini' library exports some simple monadic functions to
	9	make parsing INI-like configuration easier. INI files have a
	10	two-level structure: the top-level named chunks of configuration,
	11	and the individual key-value pairs contained within those chunks.
	12	For example, the following INI file has two sections, @NETWORK@
	13	and @LOCAL@, and each contains its own key-value pairs. Comments,
	14	which begin with @#@ or @;@, are ignored:
	15	--
	16	> [NETWORK]
	17	> host = example.com
	18	> port = 7878
	19	>
	20	> # here is a comment
	21	> [LOCAL]
	22	> user = terry
	23	--
	24	The combinators provided here are designed to write quick and
	25	idiomatic parsers for files of this form. Sections are parsed by
	26	'IniParser' computations, like 'section' and its variations,
	27	while the fields within sections are parsed by 'SectionParser'
	28	computations, like 'field' and its variations. If we want to
	29	parse an INI file like the one above, treating the entire
	30	@LOCAL@ section as optional, we can write it like this:
	31	--
	32	> data Config = Config
	33	> { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
	34	> deriving (Eq, Show)
	35	>
	36	> data NetworkConfig = NetworkConfig
	37	> { netHost :: String, netPort :: Int }
	38	> deriving (Eq, Show)
	39	>
	40	> data LocalConfig = LocalConfig
	41	> { localUser :: Text }
	42	> deriving (Eq, Show)
	43	>
	44	> configParser :: IniParser Config
	45	> configParser = do
	46	> netCf <- section "NETWORK" $ do
	47	> host <- fieldOf "host" string
	48	> port <- fieldOf "port" number
	49	> return NetworkConfig { netHost = host, netPort = port }
	50	> locCf <- sectionMb "LOCAL" $
	51	> LocalConfig <$> field "user"
	52	> return Config { cfNetwork = netCf, cfLocal = locCf }
	53	--
	54	We can run our computation with 'parseIniFile', which,
	55	when run on our example file above, would produce the
	56	following:
	57	--
	58	>>> parseIniFile example configParser
	59	Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})
	60
	61	-}
	62
1	63	{-# LANGUAGE OverloadedStrings #-}
2	64	{-# LANGUAGE ScopedTypeVariables #-}
3	65	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4	66
5	67	module Data.Ini.Config
6	68	(
7		-- $main
8		-- * Running Parsers
	69	-- * Parsing Files
9	70	parseIniFile
10	71	-- * Parser Types
11	72	, IniParser

28	89	, number
29	90	, string
30	91	, flag
	92	, listWithSeparator
31	93	) where
32	94
33	95	import Control.Applicative (Applicative(..), Alternative(..))
34	96	import Control.Monad.Trans.Except
35		import qualified Data.HashMap.Strict as HM
36	97	import Data.Ini.Config.Raw
	98	import Data.Sequence (Seq)
	99	import qualified Data.Sequence as Seq
37	100	import Data.String (IsString(..))
38	101	import Data.Text (Text)
39	102	import qualified Data.Text as T
40	103	import Data.Typeable (Typeable, Proxy(..), typeRep)
	104	import GHC.Exts (IsList(..))
41	105	import Text.Read (readMaybe)
	106
	107	lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
	108	lkp t = go . Seq.viewl
	109	where go ((t', x) Seq.:< rs)
	110	\| t == t' = Just x
	111	\| otherwise = go (Seq.viewl rs)
	112	go Seq.EmptyL = Nothing
42	113
43	114	addLineInformation :: Int -> Text -> StParser s a -> StParser s a
44	115	addLineInformation lineNo sec = withExceptT go

50	121
51	122	-- \| An 'IniParser' value represents a computation for parsing entire
52	123	-- INI-format files.
53		newtype IniParser a = IniParser (StParser Ini a)
	124	newtype IniParser a = IniParser (StParser RawIni a)
54	125	deriving (Functor, Applicative, Alternative, Monad)
55	126
56	127	-- \| A 'SectionParser' value represents a computation for parsing a single

61	132	-- \| Parse a 'Text' value as an INI file and run an 'IniParser' over it
62	133	parseIniFile :: Text -> IniParser a -> Either String a
63	134	parseIniFile text (IniParser mote) = do
64		ini <- parseIni text
	135	ini <- parseRawIni text
65	136	runExceptT mote ini
66	137
67	138	-- \| Find a named section in the INI file and parse it with the provided

74	145	-- >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x")
75	146	-- Left "No top-level section named \"TWO\""
76	147	section :: Text -> SectionParser a -> IniParser a
77		section name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
78		case HM.lookup (T.toLower name) ini of
	148	section name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
	149	case lkp (normalize name) ini of
79	150	Nothing -> Left ("No top-level section named " ++ show name)
80	151	Just sec -> runExceptT thunk sec
81	152

90	161	-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x")
91	162	-- Right Nothing
92	163	sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
93		sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
94		case HM.lookup (T.toLower name) ini of
	164	sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
	165	case lkp (normalize name) ini of
95	166	Nothing -> return Nothing
96	167	Just sec -> Just `fmap` runExceptT thunk sec
97	168

106	177	-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x")
107	178	-- Right "def"
108	179	sectionDef :: Text -> a -> SectionParser a -> IniParser a
109		sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
110		case HM.lookup (T.toLower name) ini of
	180	sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->
	181	case lkp (normalize name) ini of
111	182	Nothing -> return def
112	183	Just sec -> runExceptT thunk sec
113	184

121	192
122	193	rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
123	194	rawFieldMb name = ExceptT $ \m ->
124		return (~~HM.lookup name~~ (isVals m))
	195	return (lkp (normalize name) (isVals m))
125	196
126	197	rawField :: Text -> StParser IniSection IniValue
127	198	rawField name = do

196	267	-- Right "def"
197	268	fieldDef :: Text -> Text -> SectionParser Text
198	269	fieldDef name def = SectionParser $ ExceptT $ \m ->
199		case ~~HM.lookup name~~ (isVals m) of
	270	case lkp (normalize name) (isVals m) of
200	271	Nothing -> return def
201	272	Just x -> return (vValue x)
202	273

271	342	number :: (Num a, Read a, Typeable a) => Text -> Either String a
272	343	number = readable
273	344
274		-- \| Convert a textua value to the appropriate string type. This will
	345	-- \| Convert a textual value to the appropriate string type. This will
275	346	-- never fail.
276	347	--
277	348	-- >>> string "foo" :: Either String String

307	378	"n" -> Right False
308	379	_ -> Left ("Unable to parse " ++ show s ++ " as a boolean")
309	380
	381	-- \| Convert a reader for a value into a reader for a list of those
	382	-- values, separated by a chosen separator. This will split apart
	383	-- the string on that separator, get rid of leading and trailing
	384	-- whitespace on the individual chunks, and then attempt to parse
	385	-- each of them according to the function provided, turning the
	386	-- result into a list.
	387	--
	388	-- This is overloaded with the "IsList" typeclass, so it can be
	389	-- used transparently to parse other list-like types.
	390	--
	391	-- >>> listWithSeparator "," number "2, 3, 4" :: Either String [Int]
	392	-- Right [2,3,4]
	393	-- >>> listWithSeparator " " number "7 8 9" :: Either String [Int]
	394	-- Right [7,8,9]
	395	-- >>> listWithSeparator ":" string "/bin:/usr/bin" :: Either String [FilePath]
	396	-- Right ["/bin","/usr/bin"]
	397	-- >>> listWithSeparator "," number "7 8 9" :: Either String [Int]
	398	-- Left "Unable to parse \"2 3 4\" as a value of type Int"
	399	listWithSeparator :: (IsList l)
	400	=> Text
	401	-> (Text -> Either String (Item l))
	402	-> Text -> Either String l
	403	listWithSeparator sep rd =
	404	fmap fromList . mapM (rd . T.strip) . T.splitOn sep
310	405
311	406	-- $setup
312	407	--

342	437	-- >>> :{
343	438	-- let example = "[NETWORK]\nhost = example.com\nport = 7878\n\n# here is a comment\n[LOCAL]\nuser = terry\n"
344	439	-- >>> :}
345
346		-- $main
347		-- The 'config-ini' library exports some simple monadic functions to
348		-- make parsing INI-like configuration easier. INI files have a
349		-- two-level structure: the top-level named chunks of configuration,
350		-- and the individual key-value pairs contained within those chunks.
351		-- For example, the following INI file has two sections, @NETWORK@
352		-- and @LOCAL@, and each contains its own key-value pairs. Comments,
353		-- which begin with @#@ or @;@, are ignored:
354		--
355		-- > [NETWORK]
356		-- > host = example.com
357		-- > port = 7878
358		-- >
359		-- > # here is a comment
360		-- > [LOCAL]
361		-- > user = terry
362		--
363		-- The combinators provided here are designed to write quick and
364		-- idiomatic parsers for files of this form. Sections are parsed by
365		-- 'IniParser' computations, like 'section' and its variations,
366		-- while the fields within sections are parsed by 'SectionParser'
367		-- computations, like 'field' and its variations. If we want to
368		-- parse an INI file like the one above, treating the entire
369		-- @LOCAL@ section as optional, we can write it like this:
370		--
371		-- > data Config = Config
372		-- > { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
373		-- > deriving (Eq, Show)
374		-- >
375		-- > data NetworkConfig = NetworkConfig
376		-- > { netHost :: String, netPort :: Int }
377		-- > deriving (Eq, Show)
378		-- >
379		-- > data LocalConfig = LocalConfig
380		-- > { localUser :: Text }
381		-- > deriving (Eq, Show)
382		-- >
383		-- > configParser :: IniParser Config
384		-- > configParser = do
385		-- > netCf <- section "NETWORK" $ do
386		-- > host <- fieldOf "host" string
387		-- > port <- fieldOf "port" number
388		-- > return NetworkConfig { netHost = host, netPort = port }
389		-- > locCf <- sectionMb "LOCAL" $
390		-- > LocalConfig <$> field "user"
391		-- > return Config { cfNetwork = netCf, cfLocal = locCf }
392		--
393		-- We can run our computation with 'parseIniFile', which,
394		-- when run on our example file above, would produce the
395		-- following:
396		--
397		-- >>> parseIniFile example configParser
398		-- Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})

-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" ]

+83

-30

test/ini-compat/Main.hs less more

1	1	{-# LANGUAGE TypeSynonymInstances #-}
	2	{-# LANGUAGE TemplateHaskell #-}
	3	{-# LANGUAGE OverloadedStrings #-}
2	4	{-# OPTIONS_GHC -fno-warn-orphans #-}
3	5
4	6	module Main where
5	7
	8	import qualified Data.Foldable as Fold
	9	import Data.Function (on)
6	10	import Data.HashMap.Strict (HashMap)
7	11	import qualified Data.HashMap.Strict as HM
8	12	import qualified Data.Ini as I1
9	13	import qualified Data.Ini.Config.Raw as I2
10		import Data.~~Monoid~~
	14	import Data.List (nubBy)
	15	import qualified Data.Sequence as Seq
11	16	import Data.Text (Text)
12	17	import qualified Data.Text as T
13	18
14		import ~~Test.QuickCheck~~
	19	import Hedgehog
	20	import qualified Hedgehog.Gen as Gen
	21	import qualified Hedgehog.Range as Range
15	22
16		iniEquiv :: ArbIni -> Bool
17		iniEquiv (ArbIni raw) = case (i1, i2) of
	23	propIniEquiv :: Property
	24	propIniEquiv = property $ do
	25	raw <- forAll mkIni
	26	let printed = I1.printIniWith I1.defaultWriteIniSettings raw
	27	i1 = I1.parseIni printed
	28	i2 = I2.parseRawIni printed
	29	case (i1, i2) of
18	30	(Right i1', Right i2') ->
19	31	let i1'' = lower i1'
20	32	i2'' = toMaps i2'
21		in i1'' == i2''
22		_ -> False
23		where pr = I1.printIniWith I1.defaultWriteIniSettings raw
24		i2 = I2.parseIni pr
25		~~i1 = I1.parseIni pr~~
	33	in i1'' === i2''
	34	_ -> failure
	35
	36	propRevIniEquiv :: Property
	37	propRevIniEquiv = property $ do
	38	raw <- forAll mkRichIni
	39	let printed = I2.printRawIni raw
	40	i1 = I1.parseIni printed
	41	i2 = I2.parseRawIni printed
	42	case (i1, i2) of
	43	(Right i1', Right i2') ->
	44	lower i1' === toMaps i2'
	45	_ -> failure
	46
	47	propIniSelfEquiv :: Property
	48	propIniSelfEquiv = property $ do
	49	raw <- forAll mkRichIni
	50	Right (toMaps raw) === fmap toMaps (I2.parseRawIni (I2.printRawIni raw))
26	51
27	52	lower :: I1.Ini -> HashMap Text (HashMap Text Text)
28		lower (I1.Ini hm) =
29		HM.fromList [ (T.toLower k, v) \| (k, v) <- HM.toList hm ]
	53	lower (I1.Ini ini) = go (fmap go ini)
	54	where go hm = HM.fromList [ (T.toLower k, v) \| (k, v) <- HM.toList hm ]
30	55
31		toMaps :: I2.Ini -> HashMap Text (HashMap Text Text)
32		toMaps (I2.Ini m) = fmap (fmap I2.vValue . I2.isVals) m
	56	toMaps :: I2.RawIni -> HashMap Text (HashMap Text Text)
	57	toMaps (I2.RawIni m) = conv (fmap sectionToPair m)
	58	where sectionToPair (name, section) =
	59	(I2.normalizedText name, conv (fmap valueToPair (I2.isVals section)))
	60	valueToPair (name, value) =
	61	(I2.normalizedText name, T.strip (I2.vValue value))
	62	conv = HM.fromList . Fold.toList
33	63
34		type AlphaNumText = T.Text
35		instance Arbitrary AlphaNumText where
36		arbitrary = T.pack <$> (listOf1 $ elements $
37		['a'..'z'] <> ['A'..'Z'] <> ['0'..'9'] <> [' '])
	64	textChunk :: Gen Text
	65	textChunk = fmap T.pack $ Gen.list (Range.linear 1 20) $ Gen.alphaNum
38	66
39		newtype ArbIni = ArbIni I1.Ini deriving (Show)
	67	mkIni :: Gen I1.Ini
	68	mkIni = do
	69	ss <- Gen.list (Range.linear 0 10) $ do
	70	name <- textChunk
	71	section <- Gen.list (Range.linear 0 10) $
	72	(,) <$> textChunk <*> textChunk
	73	return (name, HM.fromList section)
	74	return (I1.Ini (HM.fromList ss))
40	75
41		instance Arbitrary ArbIni where
42		arbitrary = (ArbIni . I1.Ini . HM.fromList) `fmap` listOf sections
43		where sections = do
44		name <- arbitrary :: Gen AlphaNumText
45		sec <- section
46		return (name, sec)
47		section = HM.fromList `fmap` listOf kv
48		kv = do
49		name <- arbitrary :: Gen AlphaNumText
50		val <- arbitrary :: Gen AlphaNumText
51		~~return (name, val~~)
	76	mkComments :: Gen (Seq.Seq I2.BlankLine)
	77	mkComments = fmap Seq.fromList $ Gen.list (Range.linear 0 5) $
	78	Gen.choice
	79	[ return I2.BlankLine
	80	, I2.CommentLine <$> Gen.element ";#" <*> textChunk
	81	]
	82
	83	mkRichIni :: Gen I2.RawIni
	84	mkRichIni = do
	85	ss <- Gen.list (Range.linear 0 100) $ do
	86	name <- textChunk
	87	section <- Gen.list (Range.linear 0 100) $ do
	88	k <- textChunk
	89	v <- textChunk
	90	cs <- mkComments
	91	return ( I2.normalize k
	92	, I2.IniValue 0 k v cs False '='
	93	)
	94	cs <- mkComments
	95	return ( I2.normalize name
	96	, I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs
	97	)
	98	return (I2.RawIni (Seq.fromList (nubBy ((==) `on` fst) ss)))
52	99
53	100	main :: IO ()
54		main = ~~quickCheck iniEquiv~~
	101	main = do
	102	_ <- checkParallel $ Group "Test.Example"
	103	[ ("propIniEquiv", propIniEquiv)
	104	, ("propRevIniEquiv", propRevIniEquiv)
	105	, ("propIniSelfEquiv", propIniSelfEquiv)
	106	]
	107	return ()

+11

-4

test/prewritten/Main.hs less more

2	2
3	3	import Data.List
4	4	import Data.Ini.Config.Raw
5		import Data.~~HashMap.Strict (HashMap~~)
	5	import Data.Sequence (Seq)
6	6	import Data.Text (Text)
	7	import qualified Data.Text as T
7	8	import qualified Data.Text.IO as T
8	9	import System.Directory
9	10	import System.Exit

19	20	]
20	21	mapM_ runTest inis
21	22
22		toMaps :: Ini -> HashMap Text (HashMap Text Text)
23		toMaps (Ini m) = fmap (fmap vValue . isVals) m
	23	type IniSeq = Seq (Text, Seq (Text, Text))
	24
	25	toMaps :: RawIni -> IniSeq
	26	toMaps (RawIni m) = fmap sectionToPair m
	27	where sectionToPair (name, section) =
	28	(normalizedText name, fmap valueToPair (isVals section))
	29	valueToPair (name, value) =
	30	(normalizedText name, T.strip (vValue value))
24	31
25	32	runTest :: FilePath -> IO ()
26	33	runTest iniF = do
27	34	let hsF = take (length iniF - 4) iniF ++ ".hs"
28	35	ini <- T.readFile (dir ++ "/" ++ iniF)
29	36	hs <- readFile (dir ++ "/" ++ hsF)
30		case parseIni ini of
	37	case parseRawIni ini of
31	38	Left err -> do
32	39	putStrLn ("Error parsing " ++ iniF)
33	40	putStrLn err