tyro (empty) → 0.1.1.0
raw patch · 7 files changed
+300/−0 lines, 7 filesdep +HUnitdep +aesondep +basesetup-changed
Dependencies added: HUnit, aeson, base, protolude, singletons, test-framework, test-framework-hunit, text, tyro
Files
- LICENSE +30/−0
- README.md +24/−0
- Setup.hs +2/−0
- src/Data/Tyro.hs +119/−0
- src/Lib/Prelude.hs +11/−0
- test/Spec.hs +65/−0
- tyro.cabal +49/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Richard Lupton (c) 2017++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 Author name here 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 @@+# tyro++`tyro` is a dependently type JSON parsing library, that provides a quick way to create JSON parsers by deriving them from a type level description of the position of the value to be obtained.++## Example++```Haskell+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++import Data.Tyro+import Data.Aeson (decode)+import Data.Text (Text)++json = "{\"key1\":[{\"key2\":41},{\"key2\":42}]}" :: Text++-- Extract [41, 42] inside the Tyro types+parsed = decode json :: Maybe ("key1" |>| List ("key2" |>| Parse Integer))++-- We can dispose of the types using unwrap+values :: Maybe [Integer]+values = fmap unwrap parsed+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Tyro.hs view
@@ -0,0 +1,119 @@+{-|+Module : Data.Tyro+Description : A library for automatically deriving JSON parsers from types+Copyright : (c) Richard Lupton, 2017+License : BSD-3+Stability : experimental+Portability : POSIX+-}+{-# LANGUAGE DataKinds, GADTs, KindSignatures, TypeOperators #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+module Data.Tyro (+ -- * Introduction+ -- $example++ -- * Building types+ Parse+, type( |>| )+, List+, unwrap++-- * Internal types+, JSBranch ) where+++import Data.Aeson ((.:))+import qualified Data.Aeson as A+import Data.Aeson.Types (Parser)+import Data.Singletons (Sing, SingI(..))+import Data.Singletons.Prelude.List (Sing(SNil, SCons))+import Data.Singletons.TypeLits ( Symbol, SSymbol, KnownSymbol+ , withKnownSymbol, symbolVal )+import Data.String (String)+import Data.Text (pack)++import Lib.Prelude+++-- $example+-- A small (artificial) example demonstrating how to use the types defined here.+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE DataKinds #-}+-- > {-# LANGUAGE TypeOperators #-}+-- > import Data.Tyro+-- > import Data.Aeson (decode)+-- > import Data.Text (Text)+-- >+-- > json = "{\"key1\":[{\"key2\":41},{\"key2\":42}]}" :: Text+-- >+-- > -- Extract [41, 42] inside the Tyro types+-- > parsed = decode json :: Maybe ("key1" |>| List ("key2" |>| Parse Integer))+-- >+-- > -- We can dispose of the types using unwrap: 'values' will have the value+-- > -- Just [41, 42]+-- > values :: Maybe [Integer]+-- > values = fmap unwrap parsed++++--------------------------------------------------------------------------------+-- Type level API using a type family to mirror JSON structure+--------------------------------------------------------------------------------++-- | @Parse a@ represents trying to parse JSON to an @a@.+type Parse a = JSBranch '[] a++-- | The type operator '|>|' provides a way of describing how to walk+-- down a JSON tree.+type family (x :: Symbol) |>| (b :: *) :: *+type instance (x :: Symbol) |>| JSBranch xs a = JSBranch (x ': xs) a++-- | The 'List' type operator constructs a parsing type for parsing+-- a list of JSON objects.+type family List (x :: *) :: *+type instance List (JSBranch xs a) = Parse [JSBranch xs a]+++--------------------------------------------------------------------------------+-- Basic dependent structure+--------------------------------------------------------------------------------++-- | 'JSBranch' is a dependent datatype which represents a walk down a JSON+-- tree. @JSBranch ["key1", "key2"] a@ represents the walk "take the value at+-- @key1@ and then the value at @key2@, and (try to) interpret that as an @a@".+data JSBranch :: [Symbol] -> * -> * where+ JSNil :: a -> JSBranch '[] a+ JSCons :: JSBranch xs a -> JSBranch (t ': xs) a+++-- | 'unwrap' unwraps a value from it's parsing type.+unwrap :: JSBranch xs a -> a+unwrap b = case b of+ JSNil x -> x+ JSCons b' -> unwrap b'+++instance (A.FromJSON a, SingI xs) => A.FromJSON (JSBranch xs a) where+ parseJSON :: (A.FromJSON a, SingI xs) => A.Value -> Parser (JSBranch xs a)+ parseJSON = parseSing sing+ where+ parseSing :: (A.FromJSON a) => Sing xs -> A.Value -> Parser (JSBranch xs a)+ parseSing s o = case s of+ SNil -> JSNil <$> A.parseJSON o+ x `SCons` xs -> case o of+ A.Object v -> let key = pack (reflectSym x) in+ JSCons <$> (v .: key >>= parseSing xs)+ _ -> empty+++-- | 'reflectSym' reflects a type level symbol into a value level string+reflectSym :: SSymbol s -> String+reflectSym s = withKnownSymbol s $ proxySym s Proxy+ where+ proxySym :: (KnownSymbol n) => SSymbol n -> Proxy n -> String+ proxySym _ = symbolVal++
+ src/Lib/Prelude.hs view
@@ -0,0 +1,11 @@+{-+Welcome to your custom Prelude+Export here everything that should always be in your library scope+For more info on what is exported by Protolude check:+https://github.com/sdiehl/protolude/blob/master/Symbols.md+-}+module Lib.Prelude+ ( module Exports+ ) where++import Protolude as Exports
+ test/Spec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+import Test.Framework as TF+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.HUnit as HU+import Test.HUnit ((~:),(@=?))++import Protolude+import Data.Tyro++import qualified Data.Aeson as A+import Data.Text (Text)++main :: IO ()+main = defaultMain tests++tests :: [ TF.Test ]+tests = [ genericJSONParserTests ]+++genericJSONParserTests :: TF.Test+genericJSONParserTests = testGroup "\nGeneric JSON Parser tests" . hUnitTestToTests $+ HU.TestList [ canExtractTextInJSBranch+ , canExtractIntegerInJSBranch+ , canExtractListInJSBranch+ , canExtractListInJSBranchWithTypeFamily ]+++--------------------------------------------------------------------------------+-- Generic JSON Parser tests+--------------------------------------------------------------------------------++canExtractTextInJSBranch :: HU.Test+canExtractTextInJSBranch = "Can extract JSBranch on Text" ~:+ let json = "{\"key1\":{\"key2\":{\"key3\":\"Some text\"}}}"+ expected = Just "Some text"+ decoded = A.decode json :: Maybe (JSBranch '["key1", "key2", "key3"] Text)+ in+ expected @=? fmap unwrap decoded++canExtractIntegerInJSBranch :: HU.Test+canExtractIntegerInJSBranch = "Can extract JSBranch on Integer" ~:+ let json = "{\"key1\":{\"key2\":{\"key3\":42}}}"+ expected = Just 42+ decoded = A.decode json :: Maybe (JSBranch '["key1", "key2", "key3"] Integer)+ in+ expected @=? fmap unwrap decoded++canExtractListInJSBranch :: HU.Test+canExtractListInJSBranch = "Can extract JSBranch on List" ~:+ let json = "{\"key1\":[{\"key2\":41},{\"key2\":42}]}"+ expected = Just [41,42]+ decoded = A.decode json :: Maybe (JSBranch '["key1"] [JSBranch '["key2"] Integer])+ in+ expected @=? (fmap (fmap unwrap) . (fmap unwrap) $ decoded)+++canExtractListInJSBranchWithTypeFamily :: HU.Test+canExtractListInJSBranchWithTypeFamily = "Can extract JSBranch on List with type family" ~:+ let json = "{\"key1\":[{\"key2\":41},{\"key2\":42}]}"+ expected = Just [41,42]+ decoded = A.decode json :: Maybe ("key1" |>| List ("key2" |>| Parse Integer))+ in+ expected @=? (fmap (fmap unwrap) . (fmap unwrap) $ decoded)
+ tyro.cabal view
@@ -0,0 +1,49 @@+name: tyro+version: 0.1.1.0+synopsis: Type derived JSON parsing using Aeson+description:+ A library for deriving JSON parsers (using Aeson) by indicating+ JSON structure at the type level.+homepage: https://github.com/rlupton20/tyro#readme+license: BSD3+license-file: LICENSE+author: Richard Lupton+maintainer: example@example.com+copyright: 2017 Richard Lupton+category: Text, Web, JSON+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Data.Tyro+ other-modules: Lib.Prelude+ build-depends: base >= 4.7 && < 5+ , protolude >= 0.1.6 && < 0.2+ , aeson+ , text+ , singletons+ default-language: Haskell2010+ default-extensions: OverloadedStrings, NoImplicitPrelude++test-suite tyro-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , tyro+ , protolude >= 0.1.6 && < 0.2+ , test-framework+ , test-framework-hunit+ , HUnit+ , text+ , aeson+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010+ default-extensions: OverloadedStrings, NoImplicitPrelude++source-repository head+ type: git+ location: https://github.com/rlupton20/tyro