Commit 1c5577d22e0f47c33050ba320bb026e85cdc6a0e - config-ini

Prototype working Bidir module, removed St as obsolete Getty Ritter 8 years ago

8 changed file(s) with 579 addition(s) and 96 deletion(s). Collapse all Expand all

+10

-6

config-ini.cabal less more

34	34	library
35	35	hs-source-dirs: src
36	36	exposed-modules: Data.Ini.Config
	37	, Data.Ini.Config.Bidir
37	38	, Data.Ini.Config.Raw
38		, Data.Ini.Config.St
39	39	ghc-options: -Wall
40	40	build-depends: base >=4.7 && <4.10
	41	, containers
41	42	, text >=1.2.2 && <1.3
42	43	, unordered-containers >=0.2.7 && <0.3
43	44	, transformers >=0.4.1 && <0.6

55	56	, config-ini
56	57	default-language: Haskell2010
57	58
58		executable ~~config~~-example
	59	executable bidir-example
59	60	if !flag(build-examples)
60	61	buildable: False
61		hs-source-dirs: examples/~~config~~-example
	62	hs-source-dirs: examples/bidir-example
62	63	main-is: Main.hs
63	64	ghc-options: -Wall
64	65	build-depends: base >=4.7 && <4.10
65	66	, text
66	67	, config-ini
	68	, microlens-th
67	69	default-language: Haskell2010
68	70
69		executable ~~lens~~-example
	71	executable config-example
70	72	if !flag(build-examples)
71	73	buildable: False
72		hs-source-dirs: examples/~~lens~~-example
	74	hs-source-dirs: examples/config-example
73	75	main-is: Main.hs
74	76	ghc-options: -Wall
75	77	build-depends: base >=4.7 && <4.10

80	82
81	83	test-suite test-ini-compat
82	84	type: exitcode-stdio-1.0
83		ghc-options: -Wall
	85	ghc-options: -Wall -prof -fprof-auto -rtsopts
84	86	default-language: Haskell2010
85	87	hs-source-dirs: test/ini-compat
86	88	main-is: Main.hs

88	90	, ini
89	91	, config-ini
90	92	, QuickCheck
	93	, containers
91	94	, unordered-containers
92	95	, text
93	96

99	102	main-is: Main.hs
100	103	build-depends: base
101	104	, config-ini
	105	, containers
102	106	, unordered-containers
103	107	, text
104	108	, directory

+46

-0

examples/bidir-example/Main.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2	{-# LANGUAGE TemplateHaskell #-}
	3
	4	module Main where
	5
	6	import Data.Ini.Config.Bidir
	7	import Data.Text (Text, unpack)
	8	import Lens.Micro.TH (makeLenses)
	9
	10	data Config = Config
	11	{ _confUsername :: Text
	12	, _confPort :: Int
	13	, _confUseEncryption :: Bool
	14	, _confHostname :: Text
	15	} deriving (Eq, Show)
	16
	17	makeLenses ''Config
	18
	19	sampleConfig :: Config
	20	sampleConfig = Config
	21	{ _confUsername = "<user>"
	22	, _confPort = 8080
	23	, _confUseEncryption = True
	24	, _confHostname = "localhost"
	25	}
	26
	27	parseConfig :: IniParser Config ()
	28	parseConfig = section "NETWORK" $ do
	29	confUsername .= fieldOf "user" text <?>
	30	[ "your username" ]
	31	confPort .= fieldOf "port" number <?>
	32	[ "the port in question" ]
	33	confUseEncryption .= flagDef "encryption" True <?>
	34	[ "whether to use encryption (defaults to true)" ]
	35	confHostname .=? field "hostname" <?>
	36	[ "hostname to connect to (optional)" ]
	37
	38	example :: Text
	39	example = "[NETWORK]\n\
	40	\user = gdritter\n\
	41	\port = 8888\n"
	42
	43	main :: IO ()
	44	main = do
	45	print (parseIniFile sampleConfig parseConfig example)
	46	putStrLn (unpack (emitIniFile sampleConfig parseConfig))

-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.St
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 :: IniStParser Config ()
26		parseConfig = sectionSt "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 (parseIniFileSt example defaultConfig parseConfig)

+341

-0

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

	1	{-# LANGUAGE RankNTypes #-}
	2	{-# LANGUAGE OverloadedStrings #-}
	3	{-# LANGUAGE ScopedTypeVariables #-}
	4	{-# LANGUAGE ExistentialQuantification #-}
	5	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
	6
	7	module Data.Ini.Config.Bidir
	8	(
	9	parseIniFile
	10	, emitIniFile
	11	-- * Bidirectional Parser Types
	12	, IniParser
	13	, SectionParser
	14	-- * Section-Level Parsing
	15	, section
	16	-- * Field-Level Parsing
	17	, (.=)
	18	, (.=?)
	19	, (<?>)
	20	, field
	21	, fieldOf
	22	, fieldDef
	23	, fieldDefOf
	24	, flag
	25	, flagDef
	26	-- * FieldValues
	27	, FieldValue(..)
	28	, text
	29	, string
	30	, number
	31	, bool
	32	, readable
	33	) where
	34
	35	import Control.Monad.Trans.State.Strict (State, runState, modify)
	36	import Data.Monoid ((<>))
	37	import Data.Sequence (Seq)
	38	import qualified Data.Sequence as Seq
	39	import Data.Text (Text)
	40	import qualified Data.Text as T
	41	import Data.Typeable (Typeable, Proxy(..), typeRep)
	42	import Text.Read (readMaybe)
	43
	44	import Data.Ini.Config.Raw
	45
	46	-- \| This is a "lens"-compatible type alias
	47	type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
	48
	49	lkp :: Text -> Seq (Text, a) -> Maybe a
	50	lkp t = go . Seq.viewl
	51	where go ((t', x) Seq.:< rs)
	52	\| t == t' = Just x
	53	\| otherwise = go (Seq.viewl rs)
	54	go Seq.EmptyL = Nothing
	55
	56	data FieldValue a = FieldValue
	57	{ fvParse :: Text -> Either String a
	58	, fvEmit :: a -> Text
	59	}
	60
	61	data OutputOptions = OutputOptions
	62	{ outputOrdering :: OutputOrdering
	63	} deriving (Eq, Show)
	64
	65	data OutputOrdering
	66	= SameAsSpecification
	67	\| SameAsInputFile
	68	deriving (Eq, Show)
	69
	70	type BidirM s a = State (Seq s) a
	71
	72	runBidirM :: BidirM s a -> Seq s
	73	runBidirM = snd . flip runState Seq.empty
	74
	75	newtype IniParser s a = IniParser (BidirM (Text, Seq (Field s)) a)
	76	deriving (Functor, Applicative, Monad)
	77
	78	newtype SectionParser s a = SectionParser (BidirM (Field s) a)
	79	deriving (Functor, Applicative, Monad)
	80
	81	section :: Text -> SectionParser s () -> IniParser s ()
	82	section name (SectionParser mote) = IniParser $ do
	83	let fields = runBidirM mote
	84	modify (Seq.\|> (name, fields))
	85
	86	data Field s
	87	= forall a. Field (Lens s s a a) (FieldDescription a) Bool
	88
	89	data FieldDescription t = FieldDescription
	90	{ fdName :: Text
	91	, fdValue :: FieldValue t
	92	, fdDefault :: Maybe t
	93	, fdComment :: Seq Text
	94	}
	95
	96	(.=) :: Lens s s t t -> FieldDescription t -> SectionParser s ()
	97	l .= f = SectionParser $ modify (Seq.\|> fd)
	98	where fd = Field l f False
	99
	100	(.=?) :: Lens s s t t -> FieldDescription t -> SectionParser s ()
	101	l .=? f = SectionParser $ modify (Seq.\|> fd)
	102	where fd = Field l f True
	103
	104	(<?>) :: FieldDescription t -> [Text] -> FieldDescription t
	105	fd <?> comment = fd { fdComment = Seq.fromList comment }
	106
	107	infixr 8 .=
	108	infixr 8 .=?
	109	infixr 9 <?>
	110
	111	field :: Text -> FieldDescription Text
	112	field name = fieldOf name text
	113
	114	fieldOf :: Text -> FieldValue a -> FieldDescription a
	115	fieldOf name value = FieldDescription
	116	{ fdName = name
	117	, fdValue = value
	118	, fdDefault = Nothing
	119	, fdComment = Seq.empty
	120	}
	121
	122	fieldDef :: Text -> Text -> FieldDescription Text
	123	fieldDef name def = fieldDefOf name def text
	124
	125	fieldDefOf :: Text -> a -> FieldValue a -> FieldDescription a
	126	fieldDefOf name def value = FieldDescription
	127	{ fdName = name
	128	, fdValue = value
	129	, fdDefault = Just def
	130	, fdComment = Seq.empty
	131	}
	132
	133	flag :: Text -> FieldDescription Bool
	134	flag name = fieldOf name bool
	135
	136	flagDef :: Text -> Bool -> FieldDescription Bool
	137	flagDef name def = fieldDefOf name def bool
	138
	139	sample :: SectionParser (Text, Int) ()
	140	sample = do
	141	_1 .= field "foo" <?> ["comment for foo"]
	142	_2 .= fieldDefOf "bar" 0 number
	143
	144	readable :: forall a. (Show a, Read a, Typeable a) => FieldValue a
	145	readable = FieldValue { fvParse = parse, fvEmit = emit }
	146	where emit = T.pack . show
	147	parse t = case readMaybe (T.unpack t) of
	148	Just v -> Right v
	149	Nothing -> Left ("Unable to parse " ++ show t ++
	150	" as a value of type " ++ show typ)
	151	typ = typeRep (prx)
	152	prx :: Proxy a
	153	prx = Proxy
	154
	155	number :: (Show a, Read a, Num a, Typeable a) => FieldValue a
	156	number = readable
	157
	158	text :: FieldValue Text
	159	text = FieldValue { fvParse = Right, fvEmit = id }
	160
	161	string :: FieldValue String
	162	string = FieldValue { fvParse = Right . T.unpack, fvEmit = T.pack }
	163
	164	bool :: FieldValue Bool
	165	bool = FieldValue { fvParse = parse, fvEmit = emit }
	166	where parse s = case T.toLower s of
	167	"true" -> Right True
	168	"yes" -> Right True
	169	"t" -> Right True
	170	"y" -> Right True
	171	"false" -> Right False
	172	"no" -> Right False
	173	"f" -> Right False
	174	"n" -> Right False
	175	_ -> Left ("Unable to parse " ++ show s ++ " as a boolean")
	176	emit True = "true"
	177	emit False = "false"
	178
	179	parseIniFile :: s -> IniParser s () -> Text -> Either String s
	180	parseIniFile def (IniParser mote) t =
	181	let spec = runBidirM mote
	182	in case parseIni t of
	183	Left err -> Left err
	184	Right (Ini ini) -> runSpec def (Seq.viewl spec) ini
	185
	186	runSpec :: s -> Seq.ViewL (Text, Seq (Field s)) -> Seq (Text, IniSection) -> Either String s
	187	runSpec s Seq.EmptyL _ = Right s
	188	runSpec s ((name, fs) Seq.:< rest) ini
	189	\| Just v <- lkp (T.toLower name) ini = do
	190	s' <- runFields s (Seq.viewl fs) v
	191	runSpec s' (Seq.viewl rest) ini
	192	\| otherwise = Left ("Unable to find section " ++ show name)
	193
	194	newtype I a = I { fromI :: a }
	195	instance Functor I where fmap f (I x) = I (f x)
	196
	197	set :: Lens s t a b -> b -> s -> t
	198	set lns x a = fromI (lns (const (I x)) a)
	199
	200	newtype C a b = C { fromC :: a }
	201	instance Functor (C a) where fmap _ (C x) = C x
	202
	203	get :: Lens s t a b -> s -> a
	204	get lns a = fromC (lns C a)
	205
	206	runFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s
	207	runFields s Seq.EmptyL _ = Right s
	208	runFields s (Field l descr optional Seq.:< fs) sect
	209	\| Just v <- lkp (fdName descr) (isVals sect) = do
	210	value <- fvParse (fdValue descr) (vValue v)
	211	runFields (set l value s) (Seq.viewl fs) sect
	212	\| Just def <- fdDefault descr =
	213	runFields (set l def s) (Seq.viewl fs) sect
	214	\| optional =
	215	runFields s (Seq.viewl fs) sect
	216	\| otherwise = Left ("Unable to find field " ++ show (fdName descr))
	217
	218	emitIniFile :: s -> IniParser s () -> Text
	219	emitIniFile s (IniParser mote) =
	220	let spec = runBidirM mote in
	221	printIni $ Ini $ fmap (\ (name, fs) -> (name, toSection s name fs)) spec
	222
	223	toSection :: s -> Text -> Seq (Field s) -> IniSection
	224	toSection s name fs = IniSection
	225	{ isName = name
	226	, isVals = fmap toVal fs
	227	, isStartLine = 0
	228	, isEndLine = 0
	229	, isComments = Seq.empty
	230	} where toVal (Field l descr optional) =
	231	( fdName descr
	232	, IniValue
	233	{ vLineNo = 0
	234	, vName = fdName descr
	235	, vValue = fvEmit (fdValue descr) (get l s)
	236	, vComments = BlankLine Seq.<\|
	237	fmap (\ ln -> CommentLine '#' (" " <> ln))
	238	(fdComment descr)
	239	, vCommentedOut = optional
	240	}
	241	)
	242
	243	-- DELETE ME LATER
	244
	245	lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
	246	lens gt st f a = (`st` a) `fmap` f (gt a)
	247
	248	_1 :: Lens (a, b) (a, b) a a
	249	_1 = lens fst (\ a (_, b) -> (a, b))
	250
	251	_2 :: Lens (a, b) (a, b) b b
	252	_2 = lens snd (\ b (a, _) -> (a, b))
	253
	254
	255	-- $main
	256	-- This module is an alternate API used for parsing INI files.
	257	-- unlike the standard API, it is bidirectional: it can be
	258	-- used to emit an INI or even produce a modified INI file
	259	-- with minimal modification.
	260	--
	261	-- This module is designed to be used with lenses: instead of
	262	-- generating a new value as a result of parsing, we start
	263	-- with a fully constructed value and then associate each field
	264	-- of the INI file with a lens into that structure. Among other
	265	-- things, this introduces more flexibility in terms of how we
	266	-- organize both the configuration file and the data type that
	267	-- represents the configuration. Consider the same example code
	268	-- that appears in the documentation for the "Data.Ini.Config"
	269	-- module, which parses a configuration file like this:
	270	--
	271	-- > [NETWORK]
	272	-- > host = example.com
	273	-- > port = 7878
	274	-- >
	275	-- > [LOCAL]
	276	-- > user = terry
	277	--
	278	-- In that example, we split the configuration into a @NetworkConfig@
	279	-- and a @LocalConfig@ type to mirror the configuration file's use of
	280	-- @[LOCAL]@ and @[NETWORK]@ sections, but we might want to keep the
	281	-- configuration data type as a single flat record, in which case our
	282	-- parsing code becomes more awkward:
	283	--
	284	-- > data Config = Config
	285	-- > { _cfHost :: String
	286	-- > , _cfPort :: Int
	287	-- > , _cfUser :: Text
	288	-- > } deriving (Eq, Show)
	289	-- >
	290	-- > -- this is not ideal
	291	-- > configParser :: IniParser Config
	292	-- > configParser = do
	293	-- > (host, port) <- section "NETWORK" $ do
	294	-- > host <- fieldOf "host" string
	295	-- > port <- fieldOf "port" number
	296	-- > return (host, port)
	297	-- > user <- section "LOCAL" $ field "user"
	298	-- > return (Config host port user)
	299	--
	300	-- We could also use repeated invocations of 'section', but this
	301	-- also makes our parsing code a lot uglier and involves unnecessary
	302	-- repetition of the @\"NETWORK\"@ literal:
	303	--
	304	-- > -- this is kind of ugly
	305	-- > configParser :: IniParser Config
	306	-- > configParser = do
	307	-- > host <- section "NETWORK" $ fieldOf "host" string
	308	-- > port <- section "NETWORK" $ fieldOf "port" number
	309	-- > user <- section "LOCAL" $ field "user"
	310	-- > return (Config host port user)
	311	--
	312	-- Assuming that we generate lenses for the @Config@ type above,
	313	-- then we can use the lens-based combinators in this module to
	314	-- write terser parsing code by providing which lens to update
	315	-- along with each field:
	316	--
	317	-- > configSpec :: IniSpec Config ()
	318	-- > configSpec = do
	319	-- > sectionSt "NETWORK" $ do
	320	-- > cfHost .= field "host" string
	321	-- > cfPort .= fieldOf "port" number
	322	-- > sectionSt "LOCAL" $ do
	323	-- > cfUser .= field "user"
	324	--
	325	-- Additionally, given a value of type @Config@, we can use the
	326	-- same specification to emit an INI file, which is useful for
	327	-- generating a valid sample configuration. To help with this,
	328	-- we can rewrite the spec to make use of the @<?>@ operator,
	329	-- which associates the field with a comment block that will
	330	-- be printed above the field in the generated INI file.
	331	--
	332	-- > configSpec :: IniSpec Config ()
	333	-- > configSpec = do
	334	-- > sectionSt "NETWORK" $ do
	335	-- > cfHost .= field "host" string <?> [ "the host" ]
	336	-- > cfPort .= fieldOf "port" number <?> [ "the port" ]
	337	-- > sectionSt "LOCAL" $ do
	338	-- > cfUser .= field "user" <?> [ "the username" ]
	339	--
	340	-- Using an existing @Config@ value here, we can produce a sample
	341	-- configuration:

+97

-38

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

2	2	( Ini(..)
3	3	, IniSection(..)
4	4	, IniValue(..)
	5	, BlankLine(..)
5	6	, parseIni
	7	, printIni
6	8	) where
7	9
8	10	import Control.Monad (void)
9		import Data.HashMap.Strict (HashMap)
10		import qualified Data.HashMap.Strict as HM
	11	import qualified Data.Foldable as F
	12	import Data.Monoid ((<>))
	13	import Data.Sequence (Seq)
	14	import qualified Data.Sequence as Seq
11	15	import Data.Text (Text)
12	16	import qualified Data.Text as T
	17	import qualified Data.Text.Lazy as LazyText
	18	import qualified Data.Text.Lazy.Builder as Builder
13	19	import Text.Megaparsec
14	20	import Text.Megaparsec.Text
15	21
16	22	-- \| An 'Ini' value is a mapping from section names to
17	23	-- 'IniSection' values.
18		newtype Ini
19		= Ini { fromIni :: HashMap Text IniSection }
20		deriving (Eq, Show)
	24	newtype Ini = Ini
	25	{ fromIni :: Seq (Text, IniSection)
	26	} deriving (Eq, Show)
21	27
22	28	-- \| An 'IniSection' consists of a name, a mapping of key-value pairs,
23	29	-- and metadata about where the section starts and ends in the file.
24	30	data IniSection = IniSection
25	31	{ isName :: Text
26		, isVals :: ~~HashMap Text IniValue~~
	32	, isVals :: Seq (Text, IniValue)
27	33	, isStartLine :: Int
28	34	, isEndLine :: Int
	35	, isComments :: Seq BlankLine
29	36	} deriving (Eq, Show)
30	37
31	38	-- \| An 'IniValue' represents a key-value mapping, and also stores the
32	39	-- line number where it appears.
33	40	data IniValue = IniValue
34		{ vLineNo :: Int
35		, vName :: Text
36		~~, vValue :: Tex~~t
	41	{ vLineNo :: Int
	42	, vName :: Text
	43	, vValue :: Text
	44	, vComments :: Seq BlankLine
	45	, vCommentedOut :: Bool
	46	-- ^ Right now, this will never show up in a parsed INI file, but
	47	-- it's used when emitting a default INI file: it causes the
	48	-- key-value line to include a leading comment as well.
37	49	} deriving (Eq, Show)
	50
	51	-- \| We want to keep track of the whitespace/comments in between KV
	52	-- lines, so this allows us to track those lines in a reproducible
	53	-- way.
	54	data BlankLine
	55	= CommentLine Char Text
	56	\| BlankLine
	57	deriving (Eq, Show)
38	58
39	59	-- \| Parse a 'Text' value into an 'Ini' value.
40	60	parseIni :: Text -> Either String Ini

44	64
45	65	pIni :: Parser Ini
46	66	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		]
	67	leading <- sBlanks
	68	pSections leading Seq.empty
53	69
54		sBlanks :: Parser ()
55		sBlanks = skipMany (void eol <\|> sComment)
	70	sBlanks :: Parser (Seq BlankLine)
	71	sBlanks = Seq.fromList <$> many ((BlankLine <$ void eol) <\|> sComment)
56	72
57		sComment :: Parser ()
	73	sComment :: Parser BlankLine
58	74	sComment = do
59		void (oneOf ";#")
60		void (manyTill anyChar eol)
	75	c <- oneOf ";#"
	76	txt <- T.pack `fmap` manyTill anyChar eol
	77	return (CommentLine c txt)
61	78
62		pSection :: Parser IniSection
63		pSection = do
	79	pSections :: Seq BlankLine -> Seq (Text, IniSection) -> Parser Ini
	80	pSections leading prevs =
	81	pSection leading prevs <\|> (Ini prevs <$ void eof)
	82
	83	pSection :: Seq BlankLine -> Seq (Text, IniSection) -> Parser Ini
	84	pSection leading prevs = do
64	85	start <- getCurrentLine
65	86	void (char '[')
66	87	name <- T.pack `fmap` some (noneOf "[]")
67	88	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		}
	89	comments <- sBlanks
	90	pPairs (T.strip name) start leading prevs comments Seq.empty
78	91
79		pPair :: Parser IniValue
80		pPair = do
	92	pPairs :: Text
	93	-> Int
	94	-> Seq BlankLine
	95	-> Seq (Text, IniSection)
	96	-> Seq BlankLine
	97	-> Seq (Text, IniValue)
	98	-> Parser Ini
	99	pPairs name start leading prevs comments pairs = newPair <\|> finishedSection
	100	where
	101	newPair = do
	102	pair <- pPair comments
	103	rs <- sBlanks
	104	pPairs name start leading prevs rs (pairs Seq.\|> (vName pair, pair))
	105	finishedSection = do
	106	end <- getCurrentLine
	107	let newSection = IniSection
	108	{ isName = name
	109	, isVals = pairs
	110	, isStartLine = start
	111	, isEndLine = end
	112	, isComments = leading
	113	}
	114	pSections comments (prevs Seq.\|> (T.toLower name, newSection))
	115
	116	pPair :: Seq BlankLine -> Parser IniValue
	117	pPair leading = do
81	118	pos <- getCurrentLine
82	119	key <- T.pack `fmap` some (noneOf "[]=:")
83	120	void (oneOf ":=")
84	121	val <- T.pack `fmap` manyTill anyChar eol
85		sBlanks
86	122	return IniValue
87		{ vLineNo = pos
88		, vName = T.strip key
89		~~, vValue = T.strip val~~
	123	{ vLineNo = pos
	124	, vName = T.strip key
	125	, vValue = T.strip val
	126	, vComments = leading
	127	, vCommentedOut = False
90	128	}
91	129
92	130	getCurrentLine :: Parser Int
93	131	getCurrentLine = (fromIntegral . unPos . sourceLine) `fmap` getPosition
	132
	133
	134	printIni :: Ini -> Text
	135	printIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromIni
	136	where
	137	build (_, ini) =
	138	F.foldMap buildComment (isComments ini) <>
	139	Builder.singleton '[' <>
	140	Builder.fromText (isName ini) <>
	141	Builder.fromString "]\n" <>
	142	F.foldMap buildKV (isVals ini)
	143	buildComment BlankLine = Builder.singleton '\n'
	144	buildComment (CommentLine c txt) =
	145	Builder.singleton c <> Builder.fromText txt <> Builder.singleton '\n'
	146	buildKV (_, val) =
	147	F.foldMap buildComment (vComments val) <>
	148	(if vCommentedOut val then Builder.fromString "# " else mempty) <>
	149	Builder.fromText (vName val) <>
	150	Builder.fromString " = " <>
	151	Builder.fromText (vValue val) <>
	152	Builder.singleton '\n'

+14

-6

src/Data/Ini/Config.hs less more

32	32
33	33	import Control.Applicative (Applicative(..), Alternative(..))
34	34	import Control.Monad.Trans.Except
35		import qualified Data.HashMap.Strict as HM
36	35	import Data.Ini.Config.Raw
	36	import Data.Sequence (Seq)
	37	import qualified Data.Sequence as Seq
37	38	import Data.String (IsString(..))
38	39	import Data.Text (Text)
39	40	import qualified Data.Text as T
40	41	import Data.Typeable (Typeable, Proxy(..), typeRep)
41	42	import Text.Read (readMaybe)
	43
	44	lkp :: Text -> Seq (Text, a) -> Maybe a
	45	lkp t = go . Seq.viewl
	46	where go ((t', x) Seq.:< rs)
	47	\| t == t' = Just x
	48	\| otherwise = go (Seq.viewl rs)
	49	go Seq.EmptyL = Nothing
42	50
43	51	addLineInformation :: Int -> Text -> StParser s a -> StParser s a
44	52	addLineInformation lineNo sec = withExceptT go

75	83	-- Left "No top-level section named \"TWO\""
76	84	section :: Text -> SectionParser a -> IniParser a
77	85	section name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
78		case ~~HM.looku~~p (T.toLower name) ini of
	86	case lkp (T.toLower name) ini of
79	87	Nothing -> Left ("No top-level section named " ++ show name)
80	88	Just sec -> runExceptT thunk sec
81	89

91	99	-- Right Nothing
92	100	sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
93	101	sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
94		case ~~HM.looku~~p (T.toLower name) ini of
	102	case lkp (T.toLower name) ini of
95	103	Nothing -> return Nothing
96	104	Just sec -> Just `fmap` runExceptT thunk sec
97	105

107	115	-- Right "def"
108	116	sectionDef :: Text -> a -> SectionParser a -> IniParser a
109	117	sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(Ini ini) ->
110		case ~~HM.looku~~p (T.toLower name) ini of
	118	case lkp (T.toLower name) ini of
111	119	Nothing -> return def
112	120	Just sec -> runExceptT thunk sec
113	121

121	129
122	130	rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
123	131	rawFieldMb name = ExceptT $ \m ->
124		return (~~HM.looku~~p name (isVals m))
	132	return (lkp name (isVals m))
125	133
126	134	rawField :: Text -> StParser IniSection IniValue
127	135	rawField name = do

196	204	-- Right "def"
197	205	fieldDef :: Text -> Text -> SectionParser Text
198	206	fieldDef name def = SectionParser $ ExceptT $ \m ->
199		case ~~HM.looku~~p name (isVals m) of
	207	case lkp name (isVals m) of
200	208	Nothing -> return def
201	209	Just x -> return (vValue x)
202	210

+66

-5

test/ini-compat/Main.hs less more

1	1	module Main where
2	2
3	3	import Data.Char
	4	import qualified Data.Foldable as Fold
4	5	import Data.HashMap.Strict (HashMap)
5	6	import qualified Data.HashMap.Strict as HM
6	7	import qualified Data.Ini as I1
7	8	import qualified Data.Ini.Config.Raw as I2
	9	import Data.List (nub)
	10	import qualified Data.Sequence as Seq
8	11	import Data.Text (Text)
9	12	import qualified Data.Text as T
10	13
11	14	import Test.QuickCheck
	15
	16	myArgs :: Args
	17	myArgs = stdArgs
12	18
13	19	iniEquiv :: ArbIni -> Bool
14	20	iniEquiv (ArbIni raw) = case (i1, i2) of

21	27	i2 = I2.parseIni pr
22	28	i1 = I1.parseIni pr
23	29
	30	revIniEquiv :: RichIni -> Bool
	31	revIniEquiv (RichIni raw) = case (i1, i2) of
	32	(Right i1', Right i2') ->
	33	let i1'' = lower i1'
	34	i2'' = toMaps i2'
	35	in i1'' == i2''
	36	_ -> False
	37	where pr = I2.printIni raw
	38	i1 = I1.parseIni pr
	39	i2 = I2.parseIni pr
	40
24	41	lower :: I1.Ini -> HashMap Text (HashMap Text Text)
25	42	lower (I1.Ini hm) =
26	43	HM.fromList [ (T.toLower k, v) \| (k, v) <- HM.toList hm ]
27	44
28	45	toMaps :: I2.Ini -> HashMap Text (HashMap Text Text)
29		toMaps (I2.Ini m) = ~~fmap (fmap I2.vValue . I2.isVals) m~~
	46	toMaps (I2.Ini m) = conv (fmap sectionToPair m)
	47	where sectionToPair (name, section) = ( name
	48	, conv (fmap valueToPair (I2.isVals section))
	49	)
	50	valueToPair (name, value) = (name, I2.vValue value)
	51	conv = HM.fromList . Fold.toList
	52
	53	newtype ArbText = ArbText { fromArbText :: Text } deriving (Show)
	54
	55	instance Arbitrary ArbText where
	56	arbitrary = (ArbText . T.pack) `fmap` listOf1 (arbitrary `suchThat` isValid)
	57	where isValid ':' = False
	58	isValid '=' = False
	59	isValid '#' = False
	60	isValid ';' = False
	61	isValid '[' = False
	62	isValid ']' = False
	63	isValid c
	64	\| isSpace c = False
	65	\| otherwise = True
30	66
31	67	newtype ArbIni = ArbIni I1.Ini deriving (Show)
32	68

36	72	name <- str
37	73	sec <- section
38	74	return (name, sec)
39		str = (T.pack `fmap` arbitrary) `suchThat` (\ t ->
40		T.all (\ c -> isAlphaNum c \|\| c == ' ')
41		~~t && not (T.null t))~~
	75	str = fromArbText `fmap` arbitrary
42	76	section = HM.fromList `fmap` listOf kv
43	77	kv = do
44	78	name <- str
45	79	val <- str
46	80	return (name, val)
47	81
	82	newtype RichIni = RichIni (I2.Ini) deriving (Show)
	83
	84	instance Arbitrary RichIni where
	85	arbitrary = (RichIni . I2.Ini . Seq.fromList . nub) `fmap` listOf sections
	86	where sections = do
	87	name <- (T.toLower . T.strip) `fmap` str
	88	sec <- section name
	89	return (name, sec)
	90	str = fromArbText `fmap` arbitrary
	91	section n = do
	92	vals <- listOf kv
	93	cs <- Seq.fromList `fmap` listOf comment
	94	return (I2.IniSection n (Seq.fromList $ nub vals) 0 0 cs)
	95	kv = do
	96	name <- T.strip `fmap` str
	97	val <- str
	98	cs <- Seq.fromList `fmap` listOf comment
	99	return (name, I2.IniValue 0 name val cs False)
	100	comment = oneof [ return I2.BlankLine
	101	, do { c <- elements ";#"
	102	; txt <- str
	103	; return (I2.CommentLine c txt)
	104	}
	105	]
	106
48	107	main :: IO ()
49		main = ~~quickCheck iniEquiv~~
	108	main = do
	109	quickCheckWith myArgs revIniEquiv
	110	quickCheckWith myArgs iniEquiv

-3

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	7	import qualified Data.Text.IO as T
8	8	import System.Directory

19	19	]
20	20	mapM_ runTest inis
21	21
22		toMaps :: Ini -> HashMap Text (HashMap Text Text)
23		toMaps (Ini m) = fmap (fmap vValue . isVals) m
	22	toMaps :: Ini -> Seq (Text, Seq (Text, Text))
	23	toMaps (Ini m) = fmap sectionToPair m
	24	where sectionToPair (name, section) = (name, fmap valueToPair (isVals section))
	25	valueToPair (name, value) = (name, vValue value)
24	26
25	27	runTest :: FilePath -> IO ()
26	28	runTest iniF = do