json-directory (empty) → 0.1.0.0

raw patch · 7 files changed

+191/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, directory, filepath, json-directory, text, unordered-containers

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +24/−0
Setup.hs +2/−0
json-directory.cabal +34/−0
jsondir/Main.hs +19/−0
src/Data/JSON/Directory.hs +77/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for json-directory++## 0.1.0.0 -- 2019-12-17++* Initial version

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Luke Clifton++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Luke Clifton nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,24 @@+Provides utilities for reading JSON structures out of directories. Directory+entries become keys in a map, and the values are sourced from the contets of+each entry.++ * Directories are recured into+ * Files ending with `.json` are read as JSON values+ * Everything else is interpreted as a string++The [example](./example) directory in this repository would result in+the following JSON value.++```json+{+  "empty": {},+  "a": "This is files will have its contents written into a JSON string.\n",+  "d": {+    "example": "Sometimes it's convenient to embed some raw JSON"+  },+  "b": 42,+  "c": {+    "nested": "You can nest directories to create a tree structure.\n"+  }+}+```

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ json-directory.cabal view

@@ -0,0 +1,34 @@+cabal-version:       2.2++name:                json-directory+version:             0.1.0.0+category:            Codec+synopsis:            Load JSON from files in a directory structure+description:         Load JSON from files in a directory structure. The object+                     created mirrors the directory structure, using filenames+                     as keys. Useful for breaking apart large JSON structures.+bug-reports:         https://github.com/luke-clifton/json-directory/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Luke Clifton+maintainer:          lukec@themk.net+copyright:           (c) 2019 Luke Clifton+extra-source-files:  CHANGELOG.md, README.md++source-repository head+  type: git+  location: https://github.com/luke-clifton/json-directory++library+  exposed-modules:+    Data.JSON.Directory+  build-depends:       base ^>=4.12.0.0, aeson, directory, filepath, text, unordered-containers+  hs-source-dirs:      src+  default-language:    Haskell2010++executable jsondir+  build-depends:       base ^>=4.12.0.0, json-directory, bytestring, aeson+  hs-source-dirs:      jsondir+  default-language:    Haskell2010+  main-is: Main.hs+

+ jsondir/Main.hs view

@@ -0,0 +1,19 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE BlockArguments #-}+module Main where++import Data.Aeson+import Control.Monad+import System.Environment+import Data.JSON.Directory+import qualified Data.ByteString.Lazy.Char8 as B++main :: IO ()+main = do+    as <- getArgs+    forM_ as \a -> do+        decodeDirectory @Value a >>= \case+            Left e -> error e+            Right v -> B.putStrLn $ encode v+

+ src/Data/JSON/Directory.hs view

@@ -0,0 +1,77 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE BlockArguments #-}+module Data.JSON.Directory+    ( decodeDirectory+    , ModifiedWhileReading+    ) where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.HashMap.Strict+import Data.List+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import System.Directory+import System.FilePath++data ModifiedWhileReading = ModifiedWhileReading FilePath+    deriving (Show)++instance Exception ModifiedWhileReading++data EntryType+    = Directory+    | JSON+    | TextFile++pathType :: FilePath -> IO (Text, EntryType)+pathType p = do+    doesDirectoryExist p >>= \case+        True -> pure (Text.pack $ takeFileName p, Directory)+        False -> pure case splitExtension (takeFileName p) of+            (name, ".json") -> (Text.pack $ name, JSON)+            _               -> (Text.pack $ takeFileName p, TextFile)++decodeDirectoryValue :: MonadIO io => FilePath -> io (Either String Value)+decodeDirectoryValue path = liftIO $ do+    time <- getModificationTime path+    ents <- listDirectory path+    kvs <- catMaybes <$> forM ents \ent -> do+        if "." `isPrefixOf` ent+        then pure Nothing+        else Just <$> do+            let path' = path </> ent+            pathType path' >>= \case+                (n, Directory) -> (n,) <$> decodeDirectoryValue path'+                (n, JSON     ) -> (n,) <$> eitherDecodeFileStrict path'+                (n, TextFile ) -> (n,) . Right . String <$> Text.readFile path'+    time2 <- getModificationTime path+    unless (time == time2) $ throwIO (ModifiedWhileReading path)++    pure $ Object <$> sequence (Data.HashMap.Strict.fromList kvs)++resultToEither :: Result a -> Either String a+resultToEither (Success a) = Right a+resultToEither (Error s)   = Left s++-- | Takes a directory and decodes it using a @`FromJSON`@ instance.+-- Each entry in the directory becomes a key, and the contents become+-- the corresponding value.+--+-- * Directories are recursed into.+-- * Files ending in @.json@ are decoded as JSON values.+-- * Everything else is assumed to be a valid unicode string.+--+-- This function can throw IO exceptions as well as a @`ModifiedWhileReading`@+-- exception if the modification time changes during processing.+decodeDirectory :: (FromJSON a, MonadIO io) => FilePath -> io (Either String a)+decodeDirectory p = do+    ev <- decodeDirectoryValue p+    pure $ do+        v <- ev+        resultToEither $ fromJSON v