wakame (empty) → 0.1.0.0

raw patch · 22 files changed

+1061/−0 lines, 22 filesdep +QuickCheckdep +basedep +doctestsetup-changed

Dependencies added: QuickCheck, base, doctest, sop-core, tasty, tasty-discover, tasty-hspec, tasty-quickcheck, text, time, wakame

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +212/−0
• Setup.hs +2/−0
• src/Wakame.hs +11/−0
• src/Wakame/Generics.hs +72/−0
• src/Wakame/Keys.hs +45/−0
• src/Wakame/Lacks.hs +13/−0
• src/Wakame/Merge.hs +28/−0
• src/Wakame/Nub.hs +40/−0
• src/Wakame/Row.hs +63/−0
• src/Wakame/Union.hs +37/−0
• src/Wakame/Utils.hs +29/−0
• test/doctest/Main.hs +48/−0
• test/examples/Main.hs +4/−0
• test/examples/Wakame/Examples/Functions.hs +146/−0
• test/examples/Wakame/Examples/RowPolymorphism.hs +57/−0
• test/examples/Wakame/Examples/Usage.hs +82/−0
• test/tasty/Main.hs +1/−0
• test/tasty/Test/Utils.hs +10/−0
• test/tasty/Test/Wakame/Row.hs +21/−0
• wakame.cabal +107/−0

@@ -0,0 +1,3 @@+# Changelog for wakame++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Hideaki Kawai (c) 2020++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.

@@ -0,0 +1,212 @@+# Wakame++[![GitHub CI](https://github.com/kayhide/wakame/workflows/CI/badge.svg)](https://github.com/kayhide/wakame/actions)++hackage? comming soon++`wakame` is a Haskell library to manipulate record fields in a row-polymorphic way.++## Overview++Here is a quick overview of what `wakame` provides.++Imagine a data type of:++```haskell+data User =+  User+  { id :: ID User+  , email :: Text+  , username :: Text+  , created_at :: UTCTime+  , updated_at :: UTCTime+  }+  deriving Generic+```++To update a subset of the `User` record's fields, first define a data type containing the fields you want to update:++```haskell+data UpdatingUser =+  UpdatingUser+  { email :: Text+  , username :: Text+  }+  deriving Generic+```++Then, write a function for doing the update:+++```haskell+updateUser :: UpdatingUser -> User -> User+updateUser updating user = fromRec $ nub $ union (toRec updating) (toRec user)+```++Here is a working example of using this function:++```haskell+> user+User {id = ID 42, email = "peter@amazing.com", username = "Peter Parker", created_at = 2020-06-16 11:22:11.991147596 UTC, updated_at = 2020-06-16 11:22:11.991147596 UTC}+> updating+UpdatingUser {email = "spider@man.com", username = "Spider Man"}+> updateUser updating user+User {id = ID 42, email = "spider@man.com", username = "Spider Man", created_at = 2020-06-16 11:22:11.991147596 UTC, updated_at = 2020-06-16 11:22:11.991147596 UTC}+```++Updating the `updated_at` field in `User` can be done in the same manner.  But+this time, let's do it without defining a separate record type:++```haskell+touchUser :: UTCTime -> User -> User+touchUser time user = fromRec $ nub $ union (toRec $ keyed @"updated_at" time) (toRec user)+```++`toRec $ keyed @"update_at" time` creates a `Row` object which has only one field:++```haskell+{ updated_at :: UTCTime }+```++And updating the user and the `updated_at` field can be done easily within the+same function:++```haskell+updateAndTouchUser :: UpdatingUser -> UTCTime -> User -> User+updateAndTouchUser updating time user =+  fromRec $ nub $ union (toRec $ updating) $ union (toRec $ keyed @"updated_at" time) (toRec user)+```++This function works as follows:++```haskell+> updateAndTouchUser updating time user+User {id = ID 42, email = "spider@man.com", username = "Spider Man", created_at = 2020-06-16 11:22:11.991147596 UTC, updated_at = 2020-06-16 11:31:35.170029827 UTC}+```++Note that using `nub` once after a chain of `union`s will be faster than using `nub`+after every individual `union`.++Wrapping up, we have done the following:++- Converting a record into its corresponding `Row` representation with the `toRow` function+- Adding, removing or replacing the fields over the `Row` with `union` and `nub`+- Converting back to a record with `fromRow`++## Row-polymorphic functions++The following `create` and `update` functions are generalized in terms of row-polymorphism.++```haskell+data ModelBase a =+  ModelBase+  { id         :: ID a+  , created_at :: UTCTime+  , updated_at :: UTCTime+  }+  deriving (Eq, Show, Generic)+++create ::+  forall a b.+  ( IsRow a+  , IsRow b+  , Lacks "id" (Of a)+  , Merge (Of a) (Of (ModelBase b)) (Of b)+  ) => a -> IO b+create x = do+  now <- getCurrentTime+  id' <- pure $ ID @b 42 -- shall be `getNextID` or something in practice.+  let y =+        fromRow+        $ merge (toRow x)+        $ toRow $ ModelBase @b id' now now+  pure y+++type OfUpdatedAt = '[ '("updated_at", UTCTime) ]++update ::+  ( IsRow a+  , IsRow b+  , Union (Of a) (Of b) ab+  , Merge OfUpdatedAt ab (Of b)+  ) => a -> b -> IO b+update updating x = do+  now <- getCurrentTime+  let y =+        fromRow+        $ merge (toRow $ keyed @"updated_at" now)+        $ union (toRow updating)+        $ toRow x+  pure y+```++- `IsRow` is a constraint which defines the `Of` type family and a pair of+  `toRow` / `fromRow` functions.+  - `wakame` defines an instance of `IsRow` for all Haskell records with a `Generic` instance.+- `Lacks` constrains a row to not have a field with the given label.+- `Merge` is a combination of `Union` and `Nub`, which do appending and removing respectively.++With these constraints and functions, you can easily write row polymorphic+functions in your application.++These examples are found at +[Wakame.Examples.Usage](https://github.com/kayhide/wakame/blob/master/test/examples/Wakame/Examples/Usage.hs).++There are other examples available at +[Wakame.Examples.Functons](https://github.com/kayhide/wakame/blob/master/test/examples/Wakame/Examples/Functions.hs).++If you're interested in row polymorphism, the Wikipedia page may help: +[Row polymorphism](https://en.wikipedia.org/wiki/Row_polymorphism).++A direct translation of the functions described in the Wikipedia page is also available at +[Wakame.Examples.RowPolymorphism](https://github.com/kayhide/wakame/blob/master/test/examples/Wakame/Examples/RowPolymorphism.hs).++++## Underlying data structure++`wakame` uses `NP` (a.k.a. "N-ary Product") as the underlying representation of+`Row`.  `NP` is a data type from the+[sop-core](https://hackage.haskell.org/package/sop-core) library.++So if you need finer control of `Row`, or if you need an advanced or+application-specific operation, you have the option of using the `NP` data type+directly, which will allow you to take advantage of the rich set of functions+from the `sop-core` library.++For more details, see the paper [True Sums Of Products](https://www.andres-loeh.de/TrueSumsOfProducts/).+++### Why not `record-sop` ?++[records-sop](https://hackage.haskell.org/package/records-sop) is a library+built on top of `sop-core`.  It focuses on the representation of a record data+type and provides a set of functions for doing conversions.++The difference is that `records-sop` is relying on `generics-sop` which is more +general and also covers non-record data types. +`wakame` is specialized for only record data types.++Although the representation data types is virtually the same between+`records-sop` and `wakame`, how to convert between data types is different.++One of the benefits of `wakame` is the ability to introduce special conversion +rules such as `keyed @"label" value` to / from `Row`.++`wakame` gives you the ability to make a single `keyed` value correspond to the+representation of a data type with one field, and any arbitrary tuple of+`keyed` values to a data type with multiple fields.+In this way, you can use a tuple of `keyed` values in place of an anonymous record.++## What is wakame?++[Wakame](https://en.wikipedia.org/wiki/Wakame) is a type of edible seaweed, popular in Japan.++The most important property of wakame is that, it changes its color when boiled.++## Contributions++Feel free to open an issue or PR.+Thanks!

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

@@ -0,0 +1,11 @@+module Wakame+  ( module X+  ) where++import Wakame.Generics ()+import Wakame.Keys as X+import Wakame.Lacks as X+import Wakame.Merge as X+import Wakame.Nub as X+import Wakame.Row as X+import Wakame.Union as X

@@ -0,0 +1,72 @@+{-# LANGUAGE UndecidableInstances #-}+module Wakame.Generics where++import Prelude++import Control.Arrow ((***))+import Data.Kind+import GHC.Generics+import GHC.TypeLits+import Wakame.Row (FIELD, IsRow (..), NP (..), Row, V (..))+import Wakame.Union (Union (..))+import Wakame.Utils (type (++))+++-- $setup+-- >>> import Wakame+-- >>> data Point = Point { x :: Double, y :: Double } deriving (Show, Generic)+++-- | Instance of @IsRow@ over generic rep+-- >>> :kind! Of Point+-- Of Point :: [(Symbol, *)]+-- = '[ '("x", Double), '("y", Double)]+--+-- >>> toRow' $ from $ Point 1.2 8.3+-- (x: 1.2) :* (y: 8.3) :* Nil+-- >>> to @Point $ fromRow' $ keyed @"x" 1.2 :* keyed @"y" 8.3 :* Nil+-- Point {x = 1.2, y = 8.3}+++instance (Generic a, IsRow' (Rep a)) => IsRow a where+  type Of a = Of' (Rep a)+  fromRow = to . fromRow'+  toRow = toRow' . from+++-- * Internal++class IsRow' f where+  type Of' f :: [FIELD]+  fromRow' :: Row (Of' f) -> f a+  toRow' :: f a -> Row (Of' f)++instance IsRow' U1 where+  type Of' U1 = '[]+  fromRow' = const U1+  toRow' = const Nil++instance IsRow' f => IsRow' (D1 i f) where+  type Of' (D1 i f) = Of' f+  fromRow' = M1 . fromRow'+  toRow' (M1 x) = toRow' x++instance IsRow' f => IsRow' (C1 i f) where+  type Of' (C1 i f) = Of' f+  fromRow' = M1 . fromRow'+  toRow' (M1 x) = toRow' x++instance (IsRow' a, IsRow' b, l ~ Of' a, r ~ Of' b, Union l r (l ++ r)) => IsRow' (a :*: b) where+  type Of' (a :*: b) = (Of' a) ++ (Of' b)+  fromRow' = uncurry (:*:) . (fromRow' *** fromRow') . ununion+  toRow' (x :*: y) = union (toRow' x) (toRow' y)++instance IsRow' (S1 ('MetaSel ('Just (key :: Symbol)) su ss ds) (Rec0 (a :: Type))) where+  type Of' (S1 ('MetaSel ('Just key) su ss ds) (Rec0 a)) = '[ '(key, a) ]+  fromRow' (V x :* Nil) = M1 $ K1 x+  toRow' (M1 (K1 x)) = V x :* Nil++instance IsRow' (S1 ('MetaSel 'Nothing su ss ds) (Rec0 (V '(key, a)))) where+  type Of' (S1 ('MetaSel 'Nothing su ss ds) (Rec0 (V '(key, a)))) = '[ '(key, a) ]+  fromRow' (x :* Nil) = M1 $ K1 x+  toRow' (M1 (K1 x)) = x :* Nil

@@ -0,0 +1,45 @@+{-# LANGUAGE UndecidableInstances #-}+module Wakame.Keys where++import Prelude++import Data.Proxy+import Data.String (IsString (..))+import GHC.Generics+import GHC.TypeLits+import Wakame.Row (V (..))+++-- $setup+-- >>> import Wakame+-- >>> data Point = Point { x :: Double, y :: Double } deriving (Show, Generic)+-- >>> pt = Point 1.2 8.3+++-- | Function to retrieve key values+--+-- Return value can be anything which has @IsString@ instance.+-- >>> import Data.Functor.Identity (Identity)+-- >>> keys pt :: [Identity String]+-- [Identity "x",Identity "y"]+keys :: (IsString s, Generic a, Keys' s (Rep a)) => a -> [s]+keys = keys' . from+++class IsString s => Keys' s f where+  keys' :: f a -> [s]++instance Keys' s a => Keys' s (D1 f a) where+  keys' (M1 x) = keys' x++instance Keys' s a => Keys' s (C1 f a) where+  keys' (M1 x) = keys' x++instance (Keys' s a, Keys' s b) => Keys' s (a :*: b) where+  keys' (x :*: y) = keys' x <> keys' y++instance (IsString s, KnownSymbol key) => Keys' s (S1 ('MetaSel ('Just key) su ss ds) a) where+  keys' _ = [fromString $ symbolVal (Proxy @key)]++instance (IsString s, KnownSymbol key) => Keys' s (S1 ('MetaSel 'Nothing su ss ds) (Rec0 (V '(key, a)))) where+  keys' _ = [fromString $ symbolVal (Proxy @key)]

@@ -0,0 +1,13 @@+module Wakame.Lacks where++import Prelude++import Data.Type.Equality+import GHC.TypeLits+import Wakame.Row (FIELD)+++-- | Typeclass to constrain not to have a certain key+class Lacks (k :: Symbol) (r :: [FIELD])+instance Lacks k '[]+instance (Lacks k r, KnownSymbol k', (k == k') ~ 'False) => Lacks k ('(k', a) ': r)

@@ -0,0 +1,28 @@+{-# LANGUAGE UndecidableInstances #-}+module Wakame.Merge where++import Prelude++import Wakame.Nub (Nub (..))+import Wakame.Row (Row)+import Wakame.Union (Union (..))+import Wakame.Utils (type (++))+++-- $setup+-- >>> import GHC.Generics+-- >>> import Wakame+-- >>> data Point = Point { x :: Double, y :: Double } deriving (Show, Generic)+-- >>> pt = Point 1.2 8.3+++-- | Typeclass of the combination of Union and Nub+-- Use this typeclass and function if the intermediate row is not necessary.+--+-- >>> merge (toRow $ keyed @"x" 42.0) (toRow pt) :: Row (Of Point)+-- (x: 42.0) :* (y: 8.3) :* Nil+class (Union l r (l ++ r), Nub (l ++ r) m) => Merge l r m where+  merge :: Row l -> Row r -> Row m++instance (Union l r (l ++ r), Nub (l ++ r) m) => Merge l r m where+  merge x y = nub $ union x y

@@ -0,0 +1,40 @@+{-# LANGUAGE UndecidableSuperClasses #-}+module Wakame.Nub where++import Prelude++import Wakame.Row (NP (..), Row, V)+++-- $setup+-- >>> import Wakame+++-- | Typeclass for reshaping fields+-- `nub` function eliminates duplicate fileds.+-- When duplication, the first element takes precedence.+-- It also reorders fields so to match the return type.+--+-- >>> toRow (keyed @"x" 42.0, keyed @"x" 56.4)+-- (x: 42.0) :* (x: 56.4) :* Nil+-- >>> nub $ toRow (keyed @"x" 42.0, keyed @"x" 56.4) :: Row '[ '("x", Double)]+-- (x: 42.0) :* Nil+class Nub s t where+  nub :: Row s -> Row t++instance Nub s '[] where+  nub _ = Nil++instance (Nub s t, HasField s p) => Nub s (p ': t) where+  nub x = getField x :* nub x+++-- | Typeclass to pick a first matched field+class HasField r p where+  getField :: Row r -> V p++instance {-# OVERLAPS #-} HasField (p ': rs) p where+  getField (x :* _) = x++instance HasField rs p => HasField (r ': rs) p where+  getField (_ :* xs) = getField xs

@@ -0,0 +1,63 @@+{-# LANGUAGE UndecidableInstances #-}+module Wakame.Row+  ( FIELD++  -- * Keyed value type and function+  , V (..)+  , Keyed+  , keyed++  -- * Row type+  , Row+  , IsRow (..)++  -- * Re-export from Data.SOP.NP+  , NP (..)+  ) where++import Prelude++import Data.Kind+import Data.Proxy+import Data.SOP.NP (NP (..))+import GHC.Generics+import GHC.TypeLits+import Wakame.Utils (Fst, Snd)+++-- | Kind of field+type FIELD = (Symbol, Type)+++-- |+-- >>> V 3 :: V '("x", Int)+-- (x: 3)+newtype V (p :: FIELD) = V { unV :: Snd p }++instance (KnownSymbol (Fst p), Show (Snd p)) => Show (V p) where+  show (V x) = "(" <> symbolVal (Proxy @(Fst p)) <> ": " <> show x <> ")"++instance (KnownSymbol (Fst p), Eq (Snd p)) => Eq (V p) where+  (==) (V x) (V y) = x == y++instance Generic (V '(k, v)) where+  type Rep (V '(k, v)) = S1 ('MetaSel ('Just k) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 v)+  from (V x) = M1 (K1 x)+  to (M1 (K1 x)) = V x++-- * Helper functions++type Keyed k v = V '(k, v)++keyed :: KnownSymbol k => v -> Keyed k v+keyed = V++-- * Row type++type Row as = NP V (as :: [FIELD])++-- | Typeclass of converting from/to @Row@+class IsRow (a :: Type) where+  type Of a :: [FIELD]+  fromRow :: Row (Of a) -> a+  toRow :: a -> Row (Of a)

@@ -0,0 +1,37 @@+{-# LANGUAGE UndecidableInstances #-}+module Wakame.Union where++import Prelude++import Control.Arrow (first)+import Wakame.Row (NP (..), Row)+import Wakame.Utils (type (++))+++-- $setup+-- >>> import GHC.Generics+-- >>> import Wakame+-- >>> data Point = Point { x :: Double, y :: Double } deriving (Show, Generic)+-- >>> pt = Point 1.2 8.3+++-- | Typeclass for composing fields+--+-- >>> union (toRow pt) (toRow (keyed @"z" 42.0))+-- (x: 1.2) :* (y: 8.3) :* (z: 42.0) :* Nil+--+-- >>> ununion (toRow pt) :: (Row '[ '("x", Double)], Row '[ '("y", Double)])+-- ((x: 1.2) :* Nil,(y: 8.3) :* Nil)+-- >>> ununion (toRow pt) :: (Row '[], Row '[ '("x", Double), '("y", Double)])+-- (Nil,(x: 1.2) :* (y: 8.3) :* Nil)+class (u ~ (l ++ r)) => Union l r u | l r -> u where+  union :: Row l -> Row r -> Row u+  ununion :: Row u -> (Row l, Row r)++instance Union '[] r r where+  union _ r = r+  ununion x = (Nil, x)++instance Union l r u => Union (x ': l) r (x ': u) where+  union (x :* xs) r = x :* union xs r+  ununion (x :* xs) = first (x :*) $ ununion xs

@@ -0,0 +1,29 @@+module Wakame.Utils where++import Prelude+++-- |+-- >>> :kind! '[Bool, Int] ++ '[]+-- '[Bool, Int] ++ '[] :: [*]+-- = '[Bool, Int]+-- >>> :kind! '[Bool, Int] ++ '[Char, Word]+-- '[Bool, Int] ++ '[Char, Word] :: [*]+-- = '[Bool, Int, Char, Word]+type family (++) (a :: [k]) (b :: [k]) :: [k]+type instance (++) '[] ys = ys+type instance (++) (x ': xs) ys = x ': (xs ++ ys)++-- |+-- >>> :kind! Fst '(Bool, Char)+-- Fst '(Bool, Char) :: *+-- = Bool+type family Fst (p :: (a, b)) :: a+type instance Fst '(a, b) = a++-- |+-- >>> :kind! Snd '(Bool, Char)+-- Snd '(Bool, Char) :: *+-- = Char+type family Snd (p :: (a, b)) :: b+type instance Snd '(a, b) = b

@@ -0,0 +1,48 @@+import Test.DocTest++main :: IO ()+main = doctest $ ["src", "test/examples"] <> extensions++extensions :: [String]+extensions =+  [ "-XBangPatterns"+  , "-XBinaryLiterals"+  , "-XConstraintKinds"+  , "-XDataKinds"+  , "-XDefaultSignatures"+  , "-XDeriveAnyClass"+  , "-XDeriveDataTypeable"+  , "-XDeriveFoldable"+  , "-XDeriveFunctor"+  , "-XDeriveGeneric"+  , "-XDeriveTraversable"+  , "-XDoAndIfThenElse"+  , "-XEmptyDataDecls"+  , "-XExistentialQuantification"+  , "-XFlexibleContexts"+  , "-XFlexibleInstances"+  , "-XFunctionalDependencies"+  , "-XGADTs"+  , "-XGeneralizedNewtypeDeriving"+  , "-XInstanceSigs"+  , "-XKindSignatures"+  , "-XLambdaCase"+  , "-XMultiParamTypeClasses"+  , "-XMultiWayIf"+  , "-XNamedFieldPuns"+  , "-XOverloadedLists"+  , "-XOverloadedStrings"+  , "-XPartialTypeSignatures"+  , "-XPatternGuards"+  , "-XPolyKinds"+  , "-XRankNTypes"+  , "-XRecordWildCards"+  , "-XScopedTypeVariables"+  , "-XStandaloneDeriving"+  , "-XTupleSections"+  , "-XTypeApplications"+  , "-XTypeFamilies"+  , "-XTypeOperators"+  , "-XTypeSynonymInstances"+  , "-XViewPatterns"+  ]

@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = putStrLn "OK"

@@ -0,0 +1,146 @@+{-# LANGUAGE DuplicateRecordFields #-}+module Wakame.Examples.Functions where++import Prelude++import GHC.Generics+import Wakame+++-- * Data types which is used in this module++data Point = Point { x :: Double, y :: Double }+  deriving (Eq, Show, Generic)++data Position = Position { x :: !Double, y :: !Double }+  deriving (Eq, Show, Generic)++data Point3d = Point3d { x :: Double, y :: Double, z :: Double }+  deriving (Eq, Show, Generic)++data Tniop = Tniop { y :: Double, x :: Double }+  deriving (Eq, Show, Generic)+++-- | An instance of @Point@ data type.+pt :: Point+pt = Point 1.2 8.3++-- | Review of @Generic@+-- Let's review the basic functionality of an instance of @Generic@ typeclass.+--+-- `from` function converts a data to its generic representation.+-- >>> from pt+-- M1 {unM1 = M1 {unM1 = M1 {unM1 = K1 {unK1 = 1.2}} :*: M1 {unM1 = K1 {unK1 = 8.3}}}}+--+-- You can construct a representation value by hand.+-- >>> rep = M1 $ M1 $ M1 (K1 1.2) :*: M1 (K1 8.3)+--+-- From the representation value, `to` function converts back to @Point@.+-- >>> to rep :: Point+-- Point {x = 1.2, y = 8.3}+--+-- Since @Position@ has the same representation, `to` works as well.+-- >>> to rep :: Position+-- Position {x = 1.2, y = 8.3}+--+-- And even so to Tuple.+-- >>> to rep :: (Double, Double)+-- (1.2,8.3)+--+-- It is sensitive to the order of elements.+-- >>> to rep :: Tniop+-- Tniop {y = 1.2, x = 8.3}++++-- * Examples of record value manipulation++-- | Round trip of Point to/from Row+-- >>> fromRow @Point $ toRow pt+-- Point {x = 1.2, y = 8.3}++-- | Converting Point to Point3d by adding z field+-- >>> fromRow @Point3d $ union (toRow pt) (toRow (keyed @"z" 42.0))+-- Point3d {x = 1.2, y = 8.3, z = 42.0}+++-- | Interfacing optional fields+--+-- `f` fills absent fileds with `0.0`.+-- >>> f $ toRow (keyed @"x" 3.5)+-- Point {x = 3.5, y = 0.0}+--+-- Ignores extra fields.+-- >>> f $ toRow (keyed @"y" 4.3, keyed @"z" 1.6)+-- Point {x = 0.0, y = 4.3}+--+-- Converts from another type of data.+-- >>> f $ toRow $ Point3d 3.5 4.3 1.6+-- Point {x = 3.5, y = 4.3}+--+-- Returns fully default value when `()` is given.+-- >>> f $ toRow ()+-- Point {x = 0.0, y = 0.0}+--+-- Works nicely no matter how the order of fields is.+-- >>> f $ toRow $ Tniop 4.3 3.5+-- Point {x = 3.5, y = 4.3}+f ::+  ( Merge props OfPoint OfPoint+  ) => Row props -> Point+f props = fromRow $ merge props def+  where+    def :: Row OfPoint+    def = toRow $ Point 0.0 0.0++type OfPoint = Of Point+++-- | Filling common fields if existing+--+-- >>> g (Person "Luke" "1979-01-01") (Timestamp "2020-04-01" "2020-04-02") :: Person+-- Person {name = "Luke", created_at = "2020-04-01"}+--+-- >>> g (Point 3.5 4.3) (Timestamp "2020-04-01" "2020-04-02") :: Point+-- Point {x = 3.5, y = 4.3}++data Timestamp =+  Timestamp+  { created_at :: String+  , updated_at :: String+  }+  deriving (Eq, Show, Generic)++data Person =+  Person+  { name       :: String+  , created_at :: String+  }+  deriving (Eq, Show, Generic)++g ::+  ( IsRow a+  , IsRow b+  , IsRow c+  , Merge (Of b) (Of a) (Of c)+  ) => a -> b -> c+g x y = fromRow $ nub $ union (toRow y) (toRow x)+++-- | Rejecting certain fields+--+-- `h` is the same as `g` except rejecting the first argument of having a field "y".+-- >>> h (Point 3.5 4.3) (Timestamp "2020-04-01" "2020-04-02") :: Point+-- ...+-- ... Couldn't match type ...+-- ...++h ::+  ( IsRow a+  , IsRow b+  , IsRow c+  , Merge (Of b) (Of a) (Of c)+  , Lacks "y" (Of a)+  ) => a -> b -> c+h x y = fromRow $ nub $ union (toRow y) (toRow x)

@@ -0,0 +1,57 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+module Wakame.Examples.RowPolymorphism where++import Prelude++import Data.Kind (Type)+import GHC.TypeLits (KnownSymbol, Symbol)+import Wakame+++-- * Row polymorphism+--+-- Theoretically, all row-polymorphic operations can be described as a+-- composition of the 3 basic functions:+--+-- - select_l :: {l} -> {l :: a | r} -> a+-- - add_l :: {l} -> a -> {absent(l) :: a | r} -> {l :: a | r}+-- - remove_l :: {l} -> {l :: a | r} -> {absent(l) :: a | r}+--+-- This module shows how to implement these functions.+++select ::+  forall (l :: Symbol) (a :: Type) r.+  ( IsRow r+  , KnownSymbol l+  , Nub (Of r) '[ '(l, a) ]+  ) =>+  r -> a+select x =+  unV (fromRow $ nub $ toRow x :: V '(l, a))+++add ::+  forall (l :: Symbol) (a :: Type) r r'.+  ( IsRow r+  , IsRow r'+  , KnownSymbol l+  , Lacks l (Of r)+  , Merge '[ '(l, a) ] (Of r) (Of r')+  ) =>+  a -> r -> r'+add e x =+  fromRow $ merge (toRow $ keyed @l e) (toRow x)+++remove ::+  forall (l :: Symbol) r r'.+  ( IsRow r+  , IsRow r'+  , KnownSymbol l+  , Lacks l (Of r')+  , Nub (Of r) (Of r')+  ) =>+  r -> r'+remove x =+  fromRow $ nub $ toRow x

@@ -0,0 +1,82 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE DuplicateRecordFields #-}+module Wakame.Examples.Usage where++import Prelude++import Data.Text (Text)+import Data.Time (UTCTime, getCurrentTime)+import GHC.Generics+import Wakame+++newtype ID a = ID Int+  deriving (Eq, Show, Generic)++data User =+  User+  { id         :: ID User+  , email      :: Text+  , username   :: Text+  , created_at :: UTCTime+  , updated_at :: UTCTime+  }+  deriving (Show, Generic)++data UpdatingUser =+  UpdatingUser+  { email    :: Text+  , username :: Text+  }+  deriving (Show, Generic)++updateUser :: UpdatingUser -> User -> User+updateUser updating user = fromRow $ nub $ union (toRow updating) (toRow user)++touchUser :: UTCTime -> User -> User+touchUser time user = fromRow $ nub $ union (toRow $ keyed @"updated_at" time) (toRow user)++updateAndTouchUser :: UpdatingUser -> UTCTime -> User -> User+updateAndTouchUser updating time user =+  fromRow $ nub $ union (toRow updating) $ union (toRow $ keyed @"updated_at" time) (toRow user)+++data ModelBase a =+  ModelBase+  { id         :: ID a+  , created_at :: UTCTime+  , updated_at :: UTCTime+  }+  deriving (Eq, Show, Generic)++create ::+  forall a b.+  ( IsRow a+  , IsRow b+  , Lacks "id" (Of a)+  , Merge (Of a) (Of (ModelBase b)) (Of b)+  ) => a -> IO b+create x = do+  now <- getCurrentTime+  id' <- pure $ ID @b 42 -- shall be `getNextID` or something in practice.+  let y =+        fromRow+        $ merge (toRow x)+        $ toRow $ ModelBase @b id' now now+  pure y++type OfUpdatedAt = '[ '("updated_at", UTCTime) ]+update ::+  ( IsRow a+  , IsRow b+  , Union (Of a) (Of b) ab+  , Merge OfUpdatedAt ab (Of b)+  ) => a -> b -> IO b+update updating x = do+  now <- getCurrentTime+  let y =+        fromRow+        $ merge (toRow $ keyed @"updated_at" now)+        $ union (toRow updating)+        $ toRow x+  pure y

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}

@@ -0,0 +1,10 @@+module Test.Utils where+++import Test.QuickCheck (Arbitrary (..))+import Wakame.Row (V (..))+++instance Arbitrary a => Arbitrary (V '(k, a)) where+  arbitrary = V <$> arbitrary+  shrink (V x) = V <$> shrink x

@@ -0,0 +1,21 @@+module Test.Wakame.Row where++import GHC.Generics+import Test.Tasty+import Test.Tasty.Hspec+import Test.Tasty.QuickCheck+import Test.Utils ()+import Wakame.Generics ()+import Wakame.Row (NP (..), V (..), fromRow, toRow)+++data Point = Point { x :: Double, y :: Double }+  deriving (Eq, Show, Generic)++prop_toRow :: (V '("x", Double), V '("y", Double)) -> Property+prop_toRow (x, y) =+  toRow (x, y) === x :* y :* Nil++prop_fromRow :: (V '("x", Double), V '("y", Double)) -> Property+prop_fromRow (x@(V x'), y@(V y')) =+  fromRow (x :* y :* Nil) === Point x' y'

@@ -0,0 +1,107 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 73bf0613f6e77822a85a95cc1850d4f2546cad347dbf7eaba5ed28d8bd6d04af++name:           wakame+version:        0.1.0.0+synopsis:       Functions to manipulate records+description:    Please see the README on GitHub at <https://github.com/kayhide/wakame>+category:       Generics, Records+homepage:       https://github.com/kayhide/wakame#readme+bug-reports:    https://github.com/kayhide/wakame/issues+author:         Hideaki Kawai+maintainer:     kayhide@gmail.com+copyright:      2020 Hideaki Kawai+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/kayhide/wakame++library+  exposed-modules:+      Wakame+      Wakame.Generics+      Wakame.Keys+      Wakame.Lacks+      Wakame.Merge+      Wakame.Nub+      Wakame.Row+      Wakame.Union+      Wakame.Utils+  other-modules:+      Paths_wakame+  hs-source-dirs:+      src+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLists OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  build-depends:+      base >=4.9 && <5.0+    , sop-core >=0.5 && <0.6+  default-language: Haskell2010++test-suite wakame-doctest+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_wakame+  hs-source-dirs:+      test/doctest+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLists OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.9 && <5.0+    , doctest >=0.16 && <1.0+    , sop-core >=0.5 && <0.6+    , wakame+  default-language: Haskell2010++test-suite wakame-examples+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Wakame.Examples.Functions+      Wakame.Examples.RowPolymorphism+      Wakame.Examples.Usage+      Paths_wakame+  hs-source-dirs:+      test/examples+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLists OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.9 && <5.0+    , sop-core >=0.5 && <0.6+    , text >=1.2 && <2.0+    , time >=1.9 && <2.0+    , wakame+  default-language: Haskell2010++test-suite wakame-tasty+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Test.Utils+      Test.Wakame.Row+      Paths_wakame+  hs-source-dirs:+      test/tasty+  default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedLists OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck >=2.13 && <3.0+    , base >=4.9 && <5.0+    , sop-core >=0.5 && <0.6+    , tasty >=1.2 && <2.0+    , tasty-discover >=4.2 && <5.0+    , tasty-hspec >=1.1 && <2.0+    , tasty-quickcheck >=0.10 && <1.0+    , wakame+  default-language: Haskell2010