Changed module org
Getty Ritter
10 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 | ]))) |