Changed module org
Getty Ritter
9 years ago
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 | {-# 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 | ]))) |