json-directory 0.1.0.0 → 0.1.0.1

raw patch · 5 files changed

+221/−31 lines, 5 filesdep +mtldep +processdep ~aesondep ~basePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: mtl, process

Dependency ranges changed: aeson, base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +31/−0
• json-directory.cabal +3/−3
• jsondir/Main.hs +90/−7
• src/Data/JSON/Directory.hs +93/−21

@@ -1,5 +1,9 @@ # Revision history for json-directory +## 0.1.0.1 -- 2020-06-02++* Add rules engine to specify how to interpret a file+ ## 0.1.0.0 -- 2019-12-17  * Initial version

@@ -2,10 +2,15 @@ entries become keys in a map, and the values are sourced from the contets of each entry. +By default+  * Directories are recured into  * Files ending with `.json` are read as JSON values  * Everything else is interpreted as a string +However, these can be modified with rules, that allow for interpreting+any sort of file as JSON.+ The [example](./example) directory in this repository would result in the following JSON value. @@ -22,3 +27,29 @@   } } ```++## `jsondir`++This package also includes an executable for turning directories into JSON+blobs.++```+jsondir [--help] [--rule <SUFFIX> <FILTER> ...]+        [--[no-]default{s,-json,-text}] <ROOT> ...++  Turn a directory structure into a JSON value++ --rule <SUFFIX> <FILTER>     Filter the contents of files with the given+                              SUFFIX with FILTER. The default rules use .json+                              files as is, and treat everything else as strings.+                              Can be specified multiple times. Rule are tried in+                              the order specified.+ --[no-]defaults              Enable or disable the default rules. Default on.+ --[no-]default-json          Enable or disable the .json file rule+ --[no-]default-text          Enable or disable the raw file to JSON string rule.+ <ROOT>                       Directory root to turn into a JSON value++ EXAMPLE+  jsondir --rule '.yml' yaml2json ./my-dir+```+

@@ -1,7 +1,7 @@ cabal-version:       2.2  name:                json-directory-version:             0.1.0.0+version:             0.1.0.1 category:            Codec synopsis:            Load JSON from files in a directory structure description:         Load JSON from files in a directory structure. The object@@ -22,12 +22,12 @@ library   exposed-modules:     Data.JSON.Directory-  build-depends:       base ^>=4.12.0.0, aeson, directory, filepath, text, unordered-containers+  build-depends:       base ^>=4.12.0.0, aeson, bytestring, 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+  build-depends:       base ^>=4.12.0.0, json-directory, bytestring, aeson, process, filepath, text, mtl   hs-source-dirs:      jsondir   default-language:    Haskell2010   main-is: Main.hs

@@ -3,17 +3,100 @@ {-# LANGUAGE BlockArguments #-} module Main where -import Data.Aeson+import Control.Exception import Control.Monad-import System.Environment+import Control.Monad.Writer+import Control.Monad.Except+import Data.Aeson+import Data.Foldable import Data.JSON.Directory+import Data.List (isSuffixOf)+import Data.Maybe (isNothing)+import System.Environment+import System.Exit+import System.IO+import System.FilePath+import System.Process+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Text as Text +parseArgs :: Bool -> Bool -> [String] -> ExceptT (Maybe String) (Writer [Rule]) [FilePath]+parseArgs b c ("--rule":rest) = case rest of+    pat:filter:rest -> do+        let+            rule = Rule+                { predicate = isSuffixOf pat+                , jsonKey   = Text.pack . takeBaseName+                , parser    =+                    let+                        parse fp = do+                            s <- readFile fp+                            r <- readCreateProcess (shell filter) s+                            pure $ idecodeStrict (BS.pack r)+                        handleFailure :: IOError -> IO (IResult Value)+                        handleFailure = pure . IError [] . displayException+                    in+                        \fp -> catch (parse fp) handleFailure+                }+        tell [rule]+        parseArgs b c rest+    _ -> throwError $ Just "Invalid argument. Expected `--rule <SUFFIX> <FILTER>`"+parseArgs b c ("--no-default-json":rest) = parseArgs False c rest+parseArgs b c ("--default-json":rest) = parseArgs True c rest+parseArgs b c ("--no-default-text":rest) = parseArgs b False rest+parseArgs b c ("--default-text":rest) = parseArgs b True rest+parseArgs b c ("--no-defaults":rest) = parseArgs False False rest+parseArgs _ _ ("--help":_) = throwError Nothing+parseArgs b c ("--":rest) = do+    when b (tell [jsonRule])+    when c (tell [textRule])+    pure rest+parseArgs b c (a:as) = (a:) <$> parseArgs b c as+parseArgs b c [] = do+    when b (tell [jsonRule])+    when c (tell [textRule])+    pure []++usage :: String+usage = "\+\jsondir [--help] [--rule <SUFFIX> <FILTER> ...]\n\+\        [--[no-]default{s,-json,-text}] <ROOT> ...\n\+\\n\+\  Turn a directory structure into a JSON value\n\+\\n\+\ --rule <SUFFIX> <FILTER>     Filter the contents of files with the given\n\+\                              SUFFIX with FILTER. The default rules use .json\n\+\                              files as is, and treat everything else as strings.\n\+\                              Can be specified multiple times. Rule are tried in\n\+\                              the order specified.\n\+\ --[no-]defaults              Enable or disable the default rules. Default on.\n\+\ --[no-]default-json          Enable or disable the .json file rule\n\+\ --[no-]default-text          Enable or disable the raw file to JSON string rule.\n\+\ <ROOT>                       Directory root to turn into a JSON value\n\+\\n\+\ EXAMPLE\n\+\  jsondir --rule '.yml' yaml2json ./my-dir\n\+\"+ main :: IO () main = do-    as <- getArgs-    forM_ as \a -> do-        decodeDirectory @Value a >>= \case-            Left e -> error e-            Right v -> B.putStrLn $ encode v+    (eRoots, rules) <- runWriter . runExceptT . parseArgs True True <$> getArgs++    case eRoots of+        Left err -> do+            traverse_ (hPutStrLn stderr) err+            if isNothing err+            then putStrLn usage+            else do+                hPutStrLn stderr "Usage:"+                hPutStrLn stderr usage+            exitFailure+        Right roots -> do+            forM_ roots \a -> do+                decodeDirectory' @Value rules a >>= \case+                    Left e -> do+                        hPutStrLn stderr $ "Error: " ++ e+                        exitFailure+                    Right v -> B.putStrLn $ encode v 

@@ -3,13 +3,25 @@ {-# LANGUAGE BlockArguments #-} module Data.JSON.Directory     ( decodeDirectory+    , decodeDirectory'+    , Rule(..)+    , IResult(..)+    , defaultRules+    , jsonRule+    , textRule+    , idecodeStrict     , ModifiedWhileReading+    , NoRuleFor     ) where  import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.Aeson+import Data.Aeson.Internal (IResult(..), formatError, ifromJSON)+import Data.Aeson.Parser.Internal (eitherDecodeStrictWith, jsonEOF)+import Data.Aeson.Types+import qualified Data.ByteString as BS import Data.HashMap.Strict import Data.List import Data.Maybe@@ -19,26 +31,65 @@ import System.Directory import System.FilePath +-- Exception is thrown if the files changed while we were+-- reading them. data ModifiedWhileReading = ModifiedWhileReading FilePath     deriving (Show)  instance Exception ModifiedWhileReading +-- Exception thrown if no rule was specified for a given file.+data NoRuleFor = NoRuleFor FilePath+    deriving Show++instance Exception NoRuleFor++-- | How to interpret a file.+data Rule = Rule+    { predicate :: FilePath -> Bool+        -- ^ A predicate to see if this rule applies.+    , jsonKey   :: FilePath -> Text+        -- ^ A function to transform the filename into a JSON key value+    , parser    :: FilePath -> IO (IResult Value)+        -- ^ Turn a file into a Value.  The @JSONPath@ in the @IResult@ will be+        -- merged into the correct location.+    }++-- | A rule that reads @.json@ files as JSON.+jsonRule :: Rule+jsonRule = Rule+    { predicate = isSuffixOf ".json"+    , jsonKey   = Text.pack . takeBaseName+    , parser    = idecodeFileStrict+    }++-- | A rule that reads any file into a JSON string.+textRule :: Rule+textRule = Rule+    { predicate = const True+    , jsonKey   = Text.pack . takeFileName+    , parser    = fmap (ISuccess . String) . Text.readFile+    }++-- | Some sane default rules. Attempts do do @`jsonRule`@ and falls back to+-- @`textRule`@+defaultRules :: [Rule]+defaultRules = [jsonRule, textRule]+ data EntryType     = Directory-    | JSON-    | TextFile+    | File (FilePath -> IO (IResult Value)) -pathType :: FilePath -> IO (Text, EntryType)-pathType p = do+pathType :: [Rule] -> FilePath -> IO (Text, EntryType)+pathType rules 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)+        False -> case find (\r -> predicate r p) rules of+            Nothing   -> throwIO $ NoRuleFor p+            Just rule -> pure (jsonKey rule p, File (parser rule)) -decodeDirectoryValue :: MonadIO io => FilePath -> io (Either String Value)-decodeDirectoryValue path = liftIO $ do+decodeDirectoryValue :: MonadIO io => [Rule] -> FilePath -> io (IResult Value)+decodeDirectoryValue rules path = liftIO $ do     time <- getModificationTime path     ents <- listDirectory path     kvs <- catMaybes <$> forM ents \ent -> do@@ -46,19 +97,34 @@         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'+            pathType rules path' >>= \case+                (n, Directory) -> (n,) . addContext n <$> decodeDirectoryValue rules path'+                (n, File parser) -> (n,) . addContext n <$> parser 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+addContext :: Text -> IResult a -> IResult a+addContext c (IError p s) = IError (Key c : p) s+addContext _ x = x +idecodeFileStrict :: (FromJSON a) => FilePath -> IO (IResult a)+idecodeFileStrict =+    fmap (toIResult . eitherDecodeStrictWith jsonEOF ifromJSON) . BS.readFile+  where+    toIResult (Left (p, s)) = IError p s+    toIResult (Right a) = ISuccess a++idecodeStrict :: (FromJSON a) => BS.ByteString -> IResult a+idecodeStrict = toIResult . eitherDecodeStrictWith jsonEOF ifromJSON+  where+    toIResult (Left (p, s)) = IError p s+    toIResult (Right a) = ISuccess a++resultToEither :: IResult a -> Either String a+resultToEither (ISuccess a) = Right a+resultToEither (IError p s) = Left $ formatError p 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.@@ -69,9 +135,15 @@ -- -- This function can throw IO exceptions as well as a @`ModifiedWhileReading`@ -- exception if the modification time changes during processing.+--+-- Uses @`defaultRules`@ decodeDirectory :: (FromJSON a, MonadIO io) => FilePath -> io (Either String a)-decodeDirectory p = do-    ev <- decodeDirectoryValue p-    pure $ do+decodeDirectory = decodeDirectory' defaultRules++-- | Like @`decodeDirectory`@ but you get to specify the rules.+decodeDirectory' :: (FromJSON a, MonadIO io) => [Rule] -> FilePath -> io (Either String a)+decodeDirectory' rules p = do+    ev <- decodeDirectoryValue rules p+    pure . resultToEither $ do         v <- ev-        resultToEither $ fromJSON v+        ifromJSON v