diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Samuel Protas (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 Samuel Protas 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,13 @@ +# composable-associations + +[![Build Status](https://travis-ci.org/SamProtas/composable-associations.svg?branch=master)](https://travis-ci.org/SamProtas/composable-associations) +[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) +[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) +[![Hackage](https://img.shields.io/hackage/v/composable-associations.svg)](https://hackage.haskell.org/package/composable-associations) + + +This package defines basic types, helper functions and Lens's. You'll probably want to import a more specific version of +this library (like composable-associations-aeson) to get access to some useful type class instances. + +Documentation available on Hackage. + 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/composable-associations.cabal b/composable-associations.cabal new file mode 100644 --- /dev/null +++ b/composable-associations.cabal @@ -0,0 +1,40 @@ +name: composable-associations +version: 0.1.0.0 +synopsis: Types and helpers for composing types into a single larger key-value type. +description: + A library providing generic types and helpers for composing types together into a a single key-value type. + . + This is useful when a normalized data model has a denormalized serialization format. Using this libraries types and + functions you build compose your data into the denormalized key-value format needed for serialization. Other + libraries provide concrete implementations for a given serialization format. +homepage: https://github.com/SamProtas/composable-associations#readme +license: BSD3 +license-file: LICENSE +author: Sam Protas +maintainer: sam.protas@gmail.com +copyright: 2017 Samuel Protas +category: Web +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.ComposableAssociation + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + +test-suite tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >= 4.7 && < 5 + , composable-associations + , lens + , tasty + , tasty-hunit + +source-repository head + type: git + location: https://github.com/SamProtas/composable-associations/tree/master/composable-associations diff --git a/src/Data/ComposableAssociation.hs b/src/Data/ComposableAssociation.hs new file mode 100644 --- /dev/null +++ b/src/Data/ComposableAssociation.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ExistentialQuantification #-} +module Data.ComposableAssociation + ( -- * Description + -- $header + + -- * Core Types + Association (..) + , (:<>) (..) + , WithAssociation + + -- * Helper Functions + , withAssociation + , asValue + , reKey + + -- * Lens + , _value + , _assoc + , _base + + -- * Generic Invalid Encoding Exception + , ObjectEncodingException (..) + ) where + +import GHC.Generics +import Data.Proxy +import Control.Exception +import Data.Typeable + +-- | A type representing a key-value association where the "key" itself exists only at the type level. +-- +-- >>> let x = Association Proxy [1, 2, 3] :: Asssociation "type-level-key" [Int] +-- +-- This type exists primarily as a way to "tag" data with a key for the purpose of serializing haskell data into +-- formats that have a key-value representation (ex: a JSON object). +-- +-- The example above represents a serializable key-value pair with a key of @"type-level-key"@ and a value of @[1, 2, 3]@. +-- +-- Storing the key as type-level information allows for unambiguous deserialization. +data Association key value = Association (Proxy key) value + deriving (Show, Eq, Generic, Functor, Foldable, Traversable) + +-- | A type representing the composition of a base type (which can be serialized into a key-value structure) along with a key-value type. +-- +-- This type exists as a way to compose a haskell value that has a key-value representation (ex: a haskell +-- record where its fields are keys to their values) with additional key-value associations into a single key-value +-- object. +-- +-- This is intended for use with @Association@ to add additional key-values to a type for the purposes of +-- serialization/deserialization. +-- +-- For example: +-- +-- >>> data User = User { name :: String, age :: Int } +-- >>> let alice = User "Alice" 26 +-- >>> let bob = User "Bob" 25 +-- >>> let charlie = User "Charlie" 27 +-- >>> let bobsFriends = [alice, charlie] +-- >>> bobAndFriends :: User :<> Association "friends" [User] +-- >>> let bobAndFriends = bob :<> Association Proxy bobsFriends +-- +-- While @(bob, bobsFriends)@ contains the same values as @bobAndFriends@, it lacks information about how to combine +-- @bob@ and @bobsFriends@ together into a single serialized key-value object (as well as how to deserialize +-- that back into haskell values). +data base :<> assoc = base :<> assoc + deriving (Show, Eq, Generic, Functor, Foldable, Traversable) + +-- | Type alias for the (:<>) type operator. +-- +-- Useful if you don't like the TypeOperators extension. +type WithAssociation base assoc = base :<> assoc + +-- | Function alias for the @(:<>)@ type constructor. +withAssociation :: a -> b -> WithAssociation a b +withAssociation = (:<>) + +-- | @_value :: Lens value value' (Association key value) (Association key value')@ +_value :: Functor f => (value -> f value') -> Association key value -> f (Association key value') +_value inj (Association key value) = Association key <$> inj value + +-- | @_assoc :: Lens assoc assoc' (base :<> assoc) (base :<> assoc')@ +_assoc :: Functor f => (assoc -> f assoc') -> base :<> assoc -> f (base :<> assoc') +_assoc inj (base :<> keyValue) = (:<>) base <$> inj keyValue + +-- | @_base :: Lens base base' (base :<> assoc) (base' :<> assoc)@ +_base :: Functor f => (base -> f base') -> base :<> assoc -> f (base' :<> assoc) +_base inj (base :<> assoc) = flip (:<>) assoc <$> inj base + +-- | Convenience function for creating associations. +-- +-- This is especially useful when type-inference elsewhere in your program will determine the type of the Association. +-- +-- >>> let x = asValue True :: Association "whatever-key" Bool +asValue :: obj -> Association key obj +asValue = Association Proxy + +-- | Convenience function for changing the type of the @Association@'s key. +-- +-- >>> let x = Association Proxy 10 :: Association "key-x" Int +-- >>> let y = reKey x :: Association "key-y" Int +reKey :: Association key obj -> Association key' obj +reKey (Association _ obj) = Association Proxy obj + +-- | Generic encoding exception for when a @:<>@ "base" cannot be encoded as something object-like. +-- +-- Each serialization should have a more specific version of this exception to convey information about the failure. +data ObjectEncodingException = forall e. Exception e => ObjectEncodingException e deriving Typeable + +instance Show ObjectEncodingException where + show (ObjectEncodingException e) = show e + +instance Exception ObjectEncodingException + +-- $header +-- This library exports core types, helper functions, and Lens's. +-- +-- Unless you're implementing a serialization library (orphan instances for these types to implement +-- serialization/deserialization for some format) you probably don't want to import this package directly. Additional +-- packages in this namespace re-export this module along with their orphan instances for serialization. diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Main where + +import Test.Tasty +import Test.Tasty.HUnit +import Control.Lens +import Data.Proxy + +import Data.ComposableAssociation + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" [unitTests] + +unitTests :: TestTree +unitTests = testGroup "Unit Tests" + [ testCase "Assoc Getter" $ setKeyTest ^. _value @?= "object" + , testCase "Assoc Modify" $ (setKeyTest & _value %~ (++ "1")) @?= Association Proxy "object1" + , testCase "Assoc Set" $ (setKeyTest & _value .~ True) @?= Association Proxy True + , testCase ":<> Getter1" $ withObjTest ^. _base @?= "a" + , testCase ":<> Modify1" $ (withObjTest & _base %~ (++ "1")) @?= "a1" :<> "b" + , testCase ":<> Set1" $ (withObjTest & _base .~ True) @?= True :<> "b" + , testCase ":<> Getter2" $ withObjTest ^. _assoc @?= "b" + , testCase ":<> Modify2" $ (withObjTest & _assoc %~ (++ "1")) @?= "a" :<> "b1" + , testCase ":<> Set2" $ (withObjTest & _assoc .~ True) @?= "a" :<> True + , testCase "Assoc :<> Assoc Base-Getter" $ withSetKeyTest ^. _base . _value @?= "a" + , testCase "Assoc :<> Assoc Key-Getter" $ withSetKeyTest ^. _assoc . _value @?= "b" + , testCase "Assoc :<> Assoc Base-Modify" $ + (withSetKeyTest & _base . _value %~ (++ "1")) @?= asValue "a1" :<> asValue "b" + , testCase "Assoc :<> Assoc Key-Modify" $ + (withSetKeyTest & _assoc . _value %~ (++ "1")) @?= asValue "a" :<> asValue "b1" ] + +setKeyTest :: Association "test" String +setKeyTest = asValue "object" + +withObjTest :: String :<> String +withObjTest = "a" :<> "b" + +withSetKeyTest :: Association "test_key_1" String :<> Association "test_key_2" String +withSetKeyTest = asValue "a" :<> asValue "b"