diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) +and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +## [0.1.0.0] - 2018-01-22 +### Added +- Initial version for picking. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Bogdan Neterebskii (c) 2018 + +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 Bogdan Neterebskii 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# aeson-picker + +Tiny library to get fields from JSON format diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/aeson-picker.cabal b/aeson-picker.cabal new file mode 100644 --- /dev/null +++ b/aeson-picker.cabal @@ -0,0 +1,44 @@ +name: aeson-picker +version: 0.1.0.0 +description: Tiny library to get fields from JSON format +homepage: https://github.com/ozzzzz/aeson-picker#readme +bug-reports: https://github.com/ozzzzz/aeson-picker/issues +author: Bogdan Neterebskii +maintainer: bog2dan1@gmail.com +copyright: (c) 2018, Bogdan Neterebskii +stability: experimental +category: Text, Web, JSON +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/ozzzzz/aeson-picker + +library + hs-source-dirs: src + exposed-modules: Data.Aeson.Picker + other-modules: Data.Aeson.Picker.Internal.Functions + build-depends: base >=4.7 && <5 + , aeson + , lens + , lens-aeson + , text + default-language: Haskell2010 + +test-suite aeson-picker-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base >=4.7 && <5 + , aeson-picker + , hspec + , text + default-language: Haskell2010 diff --git a/src/Data/Aeson/Picker.hs b/src/Data/Aeson/Picker.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aeson/Picker.hs @@ -0,0 +1,6 @@ +module Data.Aeson.Picker + ( (|--) + , (|-?) + ) where + +import Data.Aeson.Picker.Internal.Functions ((|--), (|-?)) diff --git a/src/Data/Aeson/Picker/Internal/Functions.hs b/src/Data/Aeson/Picker/Internal/Functions.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aeson/Picker/Internal/Functions.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} + +module Data.Aeson.Picker.Internal.Functions + ( (|--) + , (|-?) + ) where + +import Control.Lens (Traversal', (^?)) +import Data.Aeson (FromJSON (..), Result (..), Value, fromJSON) +import Data.Aeson.Lens +import Data.Maybe (fromJust) +import Data.Text (Text) + +infix 5 |-- +(|--) :: (AsValue t, FromJSON a) => t -> [Text] -> a +json |-- [] = getFromValue . fromJust $ json ^? _Value +json |-- selectors = getFromValue . fromJust $ json ^? genGetter selectors + +infix 5 |-? +(|-?) :: (AsValue t, FromJSON a) => t -> [Text] -> Maybe a +json |-? [] = (json ^? _Value) >>= getFromValueM +json |-? selectors = (json ^? genGetter selectors) >>= getFromValueM + +genGetter :: AsValue t => [Text] -> Traversal' t Value +genGetter [] = error "selector should has at least one field" +genGetter [x] = key x +genGetter (x:xs) = key x . genGetter xs + +getFromValue :: FromJSON a => Value -> a +getFromValue value = case fromJSON value of + Success r -> r + Error e -> error e + +getFromValueM :: FromJSON a => Value -> Maybe a +getFromValueM value = case fromJSON value of + Success r -> Just r + Error e -> Nothing diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.Aeson.Picker +import Data.Text (Text, unpack) +import Test.Hspec + +exampleJSON :: Text +exampleJSON = "{\"object-like\":{\"string-like\":\"this is string\", \"int-like\": 42}, \"float-like\":1.2}" + +main :: IO () +main = hspec $ do + describe ("With JSON " ++ unpack exampleJSON) $ do + it "|-- [\"float-like\"]" $ + (exampleJSON |-- ["float-like"]) `shouldBe` (1.2 :: Float) + it "|-- [\"object-like\", \"string-like\"]" $ + (exampleJSON |-- ["object-like", "string-like"]) `shouldBe` ("this is string" :: String) + it "|-- [\"object-like\", \"int-like\"]" $ + (exampleJSON |-- ["object-like", "int-like"]) `shouldBe` (42 :: Int) + + + +