Commit master - yaml-dir - gdritter repos

Changed module org Getty Ritter 9 years ago

3 changed file(s) with 173 addition(s) and 173 deletion(s). Collapse all Expand all

+172

-0

Data/Yaml/Dir.hs less more

	1	{-# LANGUAGE MultiWayIf #-}
	2	{-# LANGUAGE ParallelListComp #-}
	3
	4	module Data.YamlDir ( -- * Only YAML files
	5	-- $yaml
	6	decodeYamlPath
	7	, decodeYamlPathEither
	8	-- * Only Text files
	9	-- $text
	10	, decodeTextPath
	11	, decodeTextPathEither
	12	-- * Files Based On Extension
	13	-- $extension
	14	, decodeExtnPath
	15	, decodeExtnPathEither
	16	) where
	17
	18	import Data.Either (either)
	19	import Data.HashMap.Strict (fromList)
	20	import Data.List (isSuffixOf)
	21	import Data.Text (pack)
	22	import qualified Data.Text.IO as T
	23	import Data.Yaml
	24	import System.Directory ( doesDirectoryExist
	25	, getDirectoryContents
	26	)
	27	import System.FilePath ((</>), takeBaseName)
	28
	29	filterDir :: IO [String] -> IO [String]
	30	filterDir = fmap (filter go)
	31	where go d = d /= "." && d /= ".."
	32
	33	toMaybe :: Either a b -> Maybe b
	34	toMaybe (Left _) = Nothing
	35	toMaybe (Right x) = Just x
	36
	37	decodePath :: FromJSON t => FileFunc -> FilePath -> IO (Maybe t)
	38	decodePath func path = fmap toMaybe (decodeEitherPath func path)
	39
	40	decodeEitherPath :: FromJSON t => FileFunc -> FilePath -> IO (Either String t)
	41	decodeEitherPath func path = do
	42	val <- parsePath func path
	43	return (val >>= parseEither parseJSON)
	44
	45	-- as-yaml functions
	46
	47	{- $yaml
	48
	49	These functions read in a directory as a YAML object and assume that
	50	each file within the directory itself contains a YAML value. For example,
	51	if we create the directory
	52
	53	> $ mkdir mydir
	54	> $ cat >mydir/foo <<EOF
	55	> > [1,2,3]
	56	> > EOF
	57	> $ cat >mydir/bar <<EOF
	58	> > baz: true
	59	> > quux: false
	60	> > EOF
	61
	62	then @decodeYamlPath "mydir"@ will return
	63
	64	> Just (Object (fromList [ ("foo", Array (fromList [ Number 1.0
	65	> , Number 2.0
	66	> , Number 3.0
	67	> ]))
	68	> , ("bar", Object (fromList [ ("baz", Bool True)
	69	> , ("quux", Bool False)
	70	> ]))
	71	> ]))
	72
	73	-}
	74
	75	decodeYamlPath :: FromJSON t => FilePath -> IO (Maybe t)
	76	decodeYamlPath = fmap toMaybe . decodeYamlPathEither
	77
	78	decodeYamlPathEither :: FromJSON t => FilePath -> IO (Either String t)
	79	decodeYamlPathEither = decodeEitherPath go
	80	where go = fmap (either (Left . show) (Right)) . decodeFileEither
	81
	82	-- as-text functions
	83
	84	{- $text
	85
	86	These functions read in a directory as a YAML object and treat each
	87	file in the directory as containing a YAML string value. For example,
	88	if we create the directory
	89
	90	> $ mkdir mydir
	91	> $ cat >mydir/foo <<EOF
	92	> > [1,2,3]
	93	> > EOF
	94	> $ cat >mydir/bar <<EOF
	95	> > baz: true
	96	> > quux: false
	97	> > EOF
	98
	99	then @decodeTextPath "mydir"@ will return
	100
	101	> Just (Object (fromList [ ("foo", String "[1,2,3]\n")
	102	> , ("bar", String "baz: true\nquux: false\n")
	103	> ]))
	104
	105	-}
	106
	107	decodeTextPath :: FromJSON t => FilePath -> IO (Maybe t)
	108	decodeTextPath = fmap toMaybe . decodeTextPathEither
	109
	110	decodeTextPathEither :: FromJSON t => FilePath -> IO (Either String t)
	111	decodeTextPathEither = decodeEitherPath go
	112	where go path = fmap (Right . String) (T.readFile path)
	113
	114	-- extension functions
	115
	116	{- $extension
	117
	118	These functions read in a directory as a YAML object and relies on
	119	the extension of a file to determine whether it is YAML or non-YAML.
	120	For example, if we create the directory
	121
	122	> $ mkdir mydir
	123	> $ cat >mydir/foo.yaml <<EOF
	124	> > [1,2,3]
	125	> > EOF
	126	> $ cat >mydir/bar.text <<EOF
	127	> > baz: true
	128	> > quux: false
	129	> > EOF
	130
	131	then @decodeExtnPath "mydir"@ will return
	132
	133	> Just (Object (fromList [ ("foo.yaml", Array (fromList [ Number 1.0
	134	> , Number 2.0
	135	> , Number 3.0
	136	> ]))
	137	> , ("bar.text", String "baz: true\nquux: false\n")
	138	> ]))
	139
	140	-}
	141
	142	decodeExtnPath :: FromJSON t => FilePath -> IO (Maybe t)
	143	decodeExtnPath = fmap toMaybe . decodeExtnPathEither
	144
	145	decodeExtnPathEither :: FromJSON t => FilePath -> IO (Either String t)
	146	decodeExtnPathEither = decodeEitherPath go
	147	where go p \| ".yaml" `isSuffixOf` p
	148	= fmap (either (Left . show) Right) (decodeFileEither p)
	149	\| otherwise
	150	= fmap (Right . String) (T.readFile p)
	151
	152	-- implementations
	153
	154	type FileFunc = FilePath -> IO (Either String Value)
	155
	156	parsePath :: FileFunc -> FilePath -> IO (Either String Value)
	157	parsePath withFile path = do
	158	isDir <- doesDirectoryExist path
	159	if \| isDir -> parseDir withFile path
	160	\| otherwise -> withFile path
	161
	162	parseDir :: FileFunc -> FilePath -> IO (Either String Value)
	163	parseDir withFile path = do
	164	ks <- filterDir (getDirectoryContents path)
	165	vs <- fmap sequence (mapM (parsePath withFile) [path </> k \| k <- ks])
	166	case vs of
	167	Left s -> return (Left s)
	168	Right vs' ->
	169	return (Right (Object (fromList [ (pack (takeBaseName k), v)
	170	\| k <- ks
	171	\| v <- vs'
	172	])))

-172

~~Data/YamlDir.hs~~ less more

1		{-# LANGUAGE MultiWayIf #-}
2		{-# LANGUAGE ParallelListComp #-}
3
4		module Data.YamlDir ( -- * Only YAML files
5		-- $yaml
6		decodeYamlPath
7		, decodeYamlPathEither
8		-- * Only Text files
9		-- $text
10		, decodeTextPath
11		, decodeTextPathEither
12		-- * Files Based On Extension
13		-- $extension
14		, decodeExtnPath
15		, decodeExtnPathEither
16		) where
17
18		import Data.Either (either)
19		import Data.HashMap.Strict (fromList)
20		import Data.List (isSuffixOf)
21		import Data.Text (pack)
22		import qualified Data.Text.IO as T
23		import Data.Yaml
24		import System.Directory ( doesDirectoryExist
25		, getDirectoryContents
26		)
27		import System.FilePath ((</>), takeBaseName)
28
29		filterDir :: IO [String] -> IO [String]
30		filterDir = fmap (filter go)
31		where go d = d /= "." && d /= ".."
32
33		toMaybe :: Either a b -> Maybe b
34		toMaybe (Left _) = Nothing
35		toMaybe (Right x) = Just x
36
37		decodePath :: FromJSON t => FileFunc -> FilePath -> IO (Maybe t)
38		decodePath func path = fmap toMaybe (decodeEitherPath func path)
39
40		decodeEitherPath :: FromJSON t => FileFunc -> FilePath -> IO (Either String t)
41		decodeEitherPath func path = do
42		val <- parsePath func path
43		return (val >>= parseEither parseJSON)
44
45		-- as-yaml functions
46
47		{- $yaml
48
49		These functions read in a directory as a YAML object and assume that
50		each file within the directory itself contains a YAML value. For example,
51		if we create the directory
52
53		> $ mkdir mydir
54		> $ cat >mydir/foo <<EOF
55		> > [1,2,3]
56		> > EOF
57		> $ cat >mydir/bar <<EOF
58		> > baz: true
59		> > quux: false
60		> > EOF
61
62		then @decodeYamlPath "mydir"@ will return
63
64		> Just (Object (fromList [ ("foo", Array (fromList [ Number 1.0
65		> , Number 2.0
66		> , Number 3.0
67		> ]))
68		> , ("bar", Object (fromList [ ("baz", Bool True)
69		> , ("quux", Bool False)
70		> ]))
71		> ]))
72
73		-}
74
75		decodeYamlPath :: FromJSON t => FilePath -> IO (Maybe t)
76		decodeYamlPath = fmap toMaybe . decodeYamlPathEither
77
78		decodeYamlPathEither :: FromJSON t => FilePath -> IO (Either String t)
79		decodeYamlPathEither = decodeEitherPath go
80		where go = fmap (either (Left . show) (Right)) . decodeFileEither
81
82		-- as-text functions
83
84		{- $text
85
86		These functions read in a directory as a YAML object and treat each
87		file in the directory as containing a YAML string value. For example,
88		if we create the directory
89
90		> $ mkdir mydir
91		> $ cat >mydir/foo <<EOF
92		> > [1,2,3]
93		> > EOF
94		> $ cat >mydir/bar <<EOF
95		> > baz: true
96		> > quux: false
97		> > EOF
98
99		then @decodeTextPath "mydir"@ will return
100
101		> Just (Object (fromList [ ("foo", String "[1,2,3]\n")
102		> , ("bar", String "baz: true\nquux: false\n")
103		> ]))
104
105		-}
106
107		decodeTextPath :: FromJSON t => FilePath -> IO (Maybe t)
108		decodeTextPath = fmap toMaybe . decodeTextPathEither
109
110		decodeTextPathEither :: FromJSON t => FilePath -> IO (Either String t)
111		decodeTextPathEither = decodeEitherPath go
112		where go path = fmap (Right . String) (T.readFile path)
113
114		-- extension functions
115
116		{- $extension
117
118		These functions read in a directory as a YAML object and relies on
119		the extension of a file to determine whether it is YAML or non-YAML.
120		For example, if we create the directory
121
122		> $ mkdir mydir
123		> $ cat >mydir/foo.yaml <<EOF
124		> > [1,2,3]
125		> > EOF
126		> $ cat >mydir/bar.text <<EOF
127		> > baz: true
128		> > quux: false
129		> > EOF
130
131		then @decodeExtnPath "mydir"@ will return
132
133		> Just (Object (fromList [ ("foo.yaml", Array (fromList [ Number 1.0
134		> , Number 2.0
135		> , Number 3.0
136		> ]))
137		> , ("bar.text", String "baz: true\nquux: false\n")
138		> ]))
139
140		-}
141
142		decodeExtnPath :: FromJSON t => FilePath -> IO (Maybe t)
143		decodeExtnPath = fmap toMaybe . decodeExtnPathEither
144
145		decodeExtnPathEither :: FromJSON t => FilePath -> IO (Either String t)
146		decodeExtnPathEither = decodeEitherPath go
147		where go p \| ".yaml" `isSuffixOf` p
148		= fmap (either (Left . show) Right) (decodeFileEither p)
149		\| otherwise
150		= fmap (Right . String) (T.readFile p)
151
152		-- implementations
153
154		type FileFunc = FilePath -> IO (Either String Value)
155
156		parsePath :: FileFunc -> FilePath -> IO (Either String Value)
157		parsePath withFile path = do
158		isDir <- doesDirectoryExist path
159		if \| isDir -> parseDir withFile path
160		\| otherwise -> withFile path
161
162		parseDir :: FileFunc -> FilePath -> IO (Either String Value)
163		parseDir withFile path = do
164		ks <- filterDir (getDirectoryContents path)
165		vs <- fmap sequence (mapM (parsePath withFile) [path </> k \| k <- ks])
166		case vs of
167		Left s -> return (Left s)
168		Right vs' ->
169		return (Right (Object (fromList [ (pack (takeBaseName k), v)
170		\| k <- ks
171		\| v <- vs'
172		])))

-1

yaml-dir.cabal less more

24	24	cabal-version: >=1.10
25	25
26	26	library
27		exposed-modules: Data.YamlDir
	27	exposed-modules: Data.Yaml.Dir
28	28	other-extensions: MultiWayIf, ParallelListComp
29	29	build-depends: base >=4.7 && <4.8,
30	30	unordered-containers >= 0.2 && <= 0.3,