smash-aeson (empty) → 0.1.0.0

raw patch · 8 files changed

+310/−0 lines, 8 filesdep +aesondep +basedep +smashsetup-changed

Dependencies added: aeson, base, smash, unordered-containers

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
README.md +5/−0
Setup.hs +2/−0
smash-aeson.cabal +37/−0
src/Data/Can/Aeson.hs +87/−0
src/Data/Smash/Aeson.hs +70/−0
src/Data/Wedge/Aeson.hs +74/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for smash-aeson++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2020, Emily Pillmore++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 Emily Pillmore 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,5 @@+# smash-aeson: Aeson support for the smash library+++[![Build Status](https://travis-ci.com/emilypi/smash.svg?branch=master)](https://travis-ci.com/emilypi/smash)+[![Hackage](https://img.shields.io/hackage/v/smash-aeson.svg)](https://hackage.haskell.org/package/smash-aeson)

+ Setup.hs view

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

+ smash-aeson.cabal view

@@ -0,0 +1,37 @@+cabal-version:       2.0+++name:                smash-aeson+version:             0.1.0.0+synopsis:            Aeson support for the smash library+description:+  Aeson support for the `smash` library+homepage:            https://github.com/emilypi/smash+bug-reports:         https://github.com/emilypi/smash/issues+license:             BSD3+license-file:        LICENSE+author:              Emily Pillmore+maintainer:          emilypi@cohomolo.gy+copyright:           (c) 2020 Emily Pillmore <emilypi@cohomolo.gy>+category:            Data+build-type:          Simple+extra-source-files:+  CHANGELOG.md+  README.md++tested-with:+  GHC ==8.2.2 || ==8.4.3 || ==8.4.4 || ==8.6.3 || ==8.6.5 || ==8.8.3 || ==8.10.1++library+  exposed-modules:     Data.Can.Aeson+                     , Data.Smash.Aeson+                     , Data.Wedge.Aeson++  build-depends:       base   >=4.10  && <5.0+                     , aeson ^>=1.4.7+                     , smash ^>=0.1.1+                     , unordered-containers++  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall

+ src/Data/Can/Aeson.hs view

@@ -0,0 +1,87 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Data.Can.Aeson+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-3-Clause+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : CPP+--+-- This module contains the Aeson instances for the 'Can' datatype.+--+module Data.Can.Aeson where+++import Data.Aeson+import Data.Aeson.Encoding (emptyObject_, pair)+import qualified Data.HashMap.Lazy as HM+import Data.Can (Can(..))+#if __GLASGOW_HASKELL__ < 804+import Data.Semigroup (Semigroup(..))+#endif+++instance (ToJSON a, ToJSON b) => ToJSON (Can a b) where+    toJSON Non = object []+    toJSON (One a) = object [ "One" .= a ]+    toJSON (Eno b) = object [ "Eno" .= b ]+    toJSON (Two a b) = object [ "One" .= a, "Eno" .= b ]++    toEncoding (One a) = pairs $ "One" .= a+    toEncoding (Eno b) = pairs $ "Eno" .= b+    toEncoding (Two a b) = pairs $ "One" .= a <> "Eno" .= b+    toEncoding Non = emptyObject_++instance (FromJSON a, FromJSON b) => FromJSON (Can a b) where+    parseJSON = withObject "Can a b" (go . HM.toList)+      where+        go [("One", a)] = One <$> parseJSON a+        go [("Eno", b)] = Eno <$> parseJSON b+        go [("One", a), ("Eno", b)] = Two <$> parseJSON a <*> parseJSON b+        go [] = pure Non+        go _  = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only"+++instance ToJSON2 Can where+    liftToJSON2 f _ _ _ (One a) = object [ "One" .= f a ]+    liftToJSON2 _ _ g _ (Eno b) = object [ "Eno" .= g b ]+    liftToJSON2 f _ g _ (Two a b) = object [ "One" .= f a, "Eno" .= g b ]+    liftToJSON2 _ _ _ _ Non = object []++    liftToEncoding2 f _ _ _ (One a) = pairs $ pair "One" (f a)+    liftToEncoding2 _ _ g _ (Eno b) = pairs $ pair "Eno" (g b)+    liftToEncoding2 f _ g _ (Two a b) = pairs $ pair "One" (f a) <> pair "Eno" (g b)+    liftToEncoding2 _ _ _ _ Non = emptyObject_+++instance ToJSON a => ToJSON1 (Can a) where+    liftToJSON _ _ (One a) = object [ "One" .= a ]+    liftToJSON g _ (Eno b) = object [ "Eno" .= g b ]+    liftToJSON g _ (Two a b) = object [ "One" .= a, "Eno" .= g b ]+    liftToJSON _ _ Non = object []++    liftToEncoding _ _ (One a) = pairs $ "One" .= a+    liftToEncoding g _ (Eno b) = pairs $ pair "Eno" (g b)+    liftToEncoding g _ (Two a b) = pairs $ "One" .= a <> pair "Eno" (g b)+    liftToEncoding _ _ Non = emptyObject_++instance FromJSON2 Can where+    liftParseJSON2 f _ g _ = withObject "Can a b" (go . HM.toList)+      where+        go [] = pure Non+        go [("One", a)] = One <$> f a+        go [("Eno", b)] = Eno <$> g b+        go [("One", a), ("Eno", b)] = Two <$> f a <*> g b+        go _  = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only"++instance FromJSON a => FromJSON1 (Can a) where+    liftParseJSON f _ = withObject "Can a b" (go . HM.toList)+      where+        go [] = pure Non+        go [("One", a)] = One <$> parseJSON a+        go [("Eno", b)] = Eno <$> f b+        go [("One", a), ("Eno", b)] = Two <$> parseJSON a <*> f b+        go _  = fail "Expected either empty object, or 'One' and 'Eno' keys, 'One' or 'Eno' keys only"

+ src/Data/Smash/Aeson.hs view

@@ -0,0 +1,70 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Data.Smash.Aeson+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-3-Clause+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : CPP+--+-- This module contains the Aeson instances for the 'Smash' datatype.+-- The 'Smash' instances,  explicitly naming the tuple entries using `SmashL` and `SmashR`+--+module Data.Smash.Aeson where+++import Data.Aeson+import Data.Aeson.Encoding (emptyObject_, pair)+import qualified Data.HashMap.Lazy as HM+#if __GLASGOW_HASKELL__ < 804+import Data.Semigroup (Semigroup(..))+#endif+import Data.Smash (Smash(..))+++instance (ToJSON a, ToJSON b) => ToJSON (Smash a b) where+    toJSON Nada = object []+    toJSON (Smash a b) = object [ "SmashL" .= a, "SmashR" .= b ]++    toEncoding (Smash a b) = pairs $ "SmashL" .= a <> "SmashR" .= b+    toEncoding Nada = emptyObject_++instance (FromJSON a, FromJSON b) => FromJSON (Smash a b) where+    parseJSON = withObject "Smash a b" (go . HM.toList)+      where+        go [("SmashL", a), ("SmashR", b)] = Smash <$> parseJSON a <*> parseJSON b+        go [] = pure Nada+        go _  = fail "Expected either empty object, or a 'Smash' pair"+++instance ToJSON2 Smash where+    liftToJSON2 f _ g _ (Smash a b) = object [ "SmashL" .= f a, "SmashR" .= g b ]+    liftToJSON2 _ _ _ _ Nada = object []++    liftToEncoding2 f _ g _ (Smash a b) = pairs $ pair "SmashL" (f a) <> pair "SmashR" (g b)+    liftToEncoding2 _ _ _ _ Nada = emptyObject_+++instance ToJSON a => ToJSON1 (Smash a) where+    liftToJSON g _ (Smash a b) = object [ "SmashL" .= a, "SmashR" .= g b ]+    liftToJSON _ _ Nada = object []++    liftToEncoding g _ (Smash a b) = pairs $ "SmashL" .= a <> pair "SmashR" (g b)+    liftToEncoding _ _ Nada = emptyObject_++instance FromJSON2 Smash where+    liftParseJSON2 f _ g _ = withObject "Smash a b" (go . HM.toList)+      where+        go [] = pure Nada+        go [("SmashL", a), ("SmashR", b)] = Smash <$> f a <*> g b+        go _ = fail "Expected either empty object, or a 'Smash' pair"++instance FromJSON a => FromJSON1 (Smash a) where+    liftParseJSON f _ = withObject "Smash a b" (go . HM.toList)+      where+        go [] = pure Nada+        go [("SmashL", a), ("SmashR", b)] = Smash <$> parseJSON a <*> f b+        go _ = fail "Expected either empty object, or a 'Smash' pair"

+ src/Data/Wedge/Aeson.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Data.Wedge.Aeson+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-3-Clause+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the Aeson instances for the 'Wedge' datatype.+--+module Data.Wedge.Aeson where+++import Data.Aeson+import Data.Aeson.Encoding (emptyObject_, pair)+import qualified Data.HashMap.Lazy as HM+import Data.Wedge (Wedge(..))+++instance (ToJSON a, ToJSON b) => ToJSON (Wedge a b) where+    toJSON Nowhere = object []+    toJSON (Here a) = object [ "Here" .= a ]+    toJSON (There b) = object [ "There" .= b ]++    toEncoding (Here a) = pairs $ "Here" .= a+    toEncoding (There b) = pairs $ "There" .= b+    toEncoding Nowhere = emptyObject_++instance (FromJSON a, FromJSON b) => FromJSON (Wedge a b) where+    parseJSON = withObject "Wedge a b" (go . HM.toList)+      where+        go [("Here", a)] = Here <$> parseJSON a+        go [("There", b)] = There <$> parseJSON b+        go [] = pure Nowhere+        go _  = fail "Expected either empty object, or one with 'Here' or 'There' keys only"+++instance ToJSON2 Wedge where+    liftToJSON2 f _ _ _ (Here a) = object [ "Here" .= f a ]+    liftToJSON2 _ _ g _ (There b) = object [ "There" .= g b ]+    liftToJSON2 _ _ _ _ Nowhere = object []++    liftToEncoding2 f _ _ _ (Here a) = pairs $ pair "Here" (f a)+    liftToEncoding2 _ _ g _ (There b) = pairs $ pair "There" (g b)+    liftToEncoding2 _ _ _ _ Nowhere = emptyObject_+++instance ToJSON a => ToJSON1 (Wedge a) where+    liftToJSON _ _ (Here a) = object [ "Here" .= a ]+    liftToJSON g _ (There b) = object [ "There" .= g b ]+    liftToJSON _ _ Nowhere = object []++    liftToEncoding _ _ (Here a) = pairs $ "Here" .= a+    liftToEncoding g _ (There b) = pairs $ pair "There" (g b)+    liftToEncoding _ _ Nowhere = emptyObject_++instance FromJSON2 Wedge where+    liftParseJSON2 f _ g _ = withObject "Wedge a b" (go . HM.toList)+      where+        go [] = pure Nowhere+        go [("Here", a)] = Here <$> f a+        go [("There", b)] = There <$> g b+        go _  = fail "Expected either empty object, or one with 'Here' or 'There' keys only"++instance FromJSON a => FromJSON1 (Wedge a) where+    liftParseJSON f _ = withObject "Wedge a b" (go . HM.toList)+      where+        go [] = pure Nowhere+        go [("Here", a)] = Here <$> parseJSON a+        go [("There", b)] = There <$> f b+        go _  = fail "Expected either empty object, or one with 'Here' or 'There' keys only"