prairie 0.0.1.1 → 0.0.2.0

raw patch · 5 files changed

+186/−109 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• prairie.cabal +2/−1
• src/Prairie/Class.hs +101/−81
• src/Prairie/TH.hs +11/−14
• test/Spec.hs +66/−13

@@ -1,5 +1,11 @@ # Changelog for prairie +## 0.0.2.0++- [#2](https://github.com/parsonsmatt/prairie/pull/2)+    - Add `tabulateRecordA` to `Record` class. `tabulate` and `allFields` are now normal functions.+    - Provide a default implementation of `recordFieldLabel` for `Show`able fields.+     ## 0.0.1.1  * [#4](https://github.com/parsonsmatt/prairie/pull/4)

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           prairie-version:        0.0.1.1+version:        0.0.2.0 description:    Please see the README on GitHub at <https://github.com/parsonsmatt/prairie#readme> homepage:       https://github.com/parsonsmatt/prairie#readme bug-reports:    https://github.com/parsonsmatt/prairie/issues@@ -86,4 +86,5 @@       base >=4.7 && <5     , prairie     , aeson+    , lens   default-language: Haskell2010

@@ -16,13 +16,14 @@ -- @since 0.0.1.0 module Prairie.Class where -import Control.Lens (Lens', set, view)+import Control.Lens (Lens', set, view, Identity(..), Const(..)) import Data.Aeson (ToJSON(..), FromJSON(..), withText) import Data.Constraint (Dict(..)) import Data.Kind (Constraint, Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text)+import qualified Data.Text as Text import Data.Typeable ((:~:)(..), Typeable, eqT) import GHC.OverloadedLabels (IsLabel(..)) import GHC.TypeLits (Symbol)@@ -33,90 +34,109 @@ -- -- @since 0.0.1.0 class Record rec where-  -- | A datatype representing fields on the record.-  ---  -- This will be a @GADT@ with one constructor for each record field. By-  -- convention, it's best to name the constructors as with the type name-  -- leading and the field name following. This convention prevents any-  -- possible conflicts from different instances of 'Field'.-  ---  -- Using our example type @User@, we would define this as:-  ---  -- @-  -- data Field User ty where-  --   UserName :: Field User String-  --   UserAge :: Field User Int-  -- @-  ---  -- Now, we have a value @UserName@ that corresponds with the @name@ field-  -- on a @User@. The type of @User@ and @name@ are interesting to compare:-  ---  -- @-  -- UserName :: Field User    String-  -- name     ::       User -> String-  -- @-  ---  -- @since 0.0.1.0-  data Field rec :: Type -> Type+    -- | A datatype representing fields on the record.+    --+    -- This will be a @GADT@ with one constructor for each record field. By+    -- convention, it's best to name the constructors as with the type name+    -- leading and the field name following. This convention prevents any+    -- possible conflicts from different instances of 'Field'.+    --+    -- Using our example type @User@, we would define this as:+    --+    -- @+    -- data Field User ty where+    --   UserName :: Field User String+    --   UserAge :: Field User Int+    -- @+    --+    -- Now, we have a value @UserName@ that corresponds with the @name@ field+    -- on a @User@. The type of @User@ and @name@ are interesting to compare:+    --+    -- @+    -- UserName :: Field User    String+    -- name     ::       User -> String+    -- @+    --+    -- @since 0.0.1.0+    data Field rec :: Type -> Type -  -- | Given a 'Field' on the record, this function acts as a 'Lens'' into-  -- the record. This allows you to use a 'Field' as a getter or setter.-  ---  -- An example implementation for our 'User' type might look like this:-  ---  -- @-  -- recordFieldLens field =-  --   case field of-  --     UserName ->-  --       'lens' name (\\u n -> u { name = n })-  --     UserAge ->-  --      'lens' age (\\u a -> u { age = a })-  -- @-  ---  -- If you have derived lenses (either from Template Haskell or-  -- @generic-lens@, then you can provide those directly.-  ---  -- @since 0.0.1.0-  recordFieldLens :: Field rec ty -> Lens' rec ty+    -- | Given a 'Field' on the record, this function acts as a 'Lens'' into+    -- the record. This allows you to use a 'Field' as a getter or setter.+    --+    -- An example implementation for our 'User' type might look like this:+    --+    -- @+    -- recordFieldLens field =+    --   case field of+    --     UserName ->+    --       'lens' name (\\u n -> u { name = n })+    --     UserAge ->+    --      'lens' age (\\u a -> u { age = a })+    -- @+    --+    -- If you have derived lenses (either from Template Haskell or+    -- @generic-lens@, then you can provide those directly.+    --+    -- @since 0.0.1.0+    recordFieldLens :: Field rec ty -> Lens' rec ty -  -- | An enumeration of fields on the record.-  ---  -- This value uses the 'SomeField' existential wrapper, which allows-  -- 'Field's containing different types to be in the same list.-  ---  -- Our @User@ example would have this implementation:-  ---  -- @-  -- allFields = [SomeField UserAge, SomeField UserName]-  -- @-  ---  -- @since 0.0.1.0-  allFields :: [SomeField rec]+    -- |  Construct a 'Record' by providing an 'Applicative' action+    -- returning a value for each 'Field' on the 'Record'.+    --+    -- Example:+    --+    -- @+    -- tabulateRecordA $ \\field -> case field of+    --     UserName -> Just "Matt"+    --     UserAge -> Nothing+    --+    -- tabulateRecordA $ \\field -> case field of+    --     UserName -> getLine+    --     UserAge -> do+    --         ageStr <- getLine+    --         case readMaybe ageStr of+    --             Nothing -> fail $ "Expected Int, got: " <> ageStr+    --             Just a -> pure a+    -- @+    --+    -- @since 0.0.2.0+    tabulateRecordA :: Applicative m => (forall ty. Field rec ty -> m ty) -> m rec -  -- | This function allows you to construct a 'Record' by providing-  -- a value for each 'Field' on the record.-  ---  -- Our @User@ would have an implementation like this:-  ---  -- @-  -- tabulateRecord fromField =-  --   User-  --     { name = fromField UserName-  --     , age = fromField UserAge-  --     }-  -- @-  ---  -- @since 0.0.1.0-  tabulateRecord :: (forall ty. Field rec ty -> ty) -> rec+    -- | Assign a 'Text' label for a record 'Field'.+    --+    -- This allows 'Field's to be converted to 'Text', which is useful for+    -- serialization concerns. For derserializing a 'Field', consider using+    -- @'fieldMap' :: 'Map' 'Text' ('SomeField' rec)@.+    --+    -- Record field labels can be given a @stock@ derived 'Show' instance,+    -- which works for the default implementation of the class.+    --+    -- @since 0.0.1.0+    recordFieldLabel :: Field rec ty -> Text+    default recordFieldLabel :: Show (Field rec ty) => Field rec ty -> Text+    recordFieldLabel = Text.pack . show -  -- | Assign a 'Text' label for a record 'Field'.-  ---  -- This allows 'Field's to be converted to 'Text', which is useful for-  -- serialization concerns. For derserializing a 'Field', consider using-  -- @'fieldMap' :: 'Map' 'Text' ('SomeField' rec)@.-  ---  -- @since 0.0.1.0-  recordFieldLabel :: Field rec ty -> Text+-- | An enumeration of fields on the record.+--+-- This value builds the fields using 'tabulateRecordA' and the 'Const'+-- type.+--+-- As of @0.0.2.0,@ this is an ordinary top-level function and not a class+-- member.+--+-- @since 0.0.1.0+allFields :: Record rec => [SomeField rec]+allFields = getConst $ tabulateRecordA $ \field ->+    Const [SomeField field]++-- | This function allows you to construct a 'Record' by providing+-- a value for each 'Field' on the record.+--+-- As of @0.0.2.0@, this is defined in terms of 'tabulateRecordA'.+--+-- @since 0.0.1.0+tabulateRecord :: Record rec => (forall ty. Field rec ty -> ty) -> rec+tabulateRecord k = runIdentity (tabulateRecordA (Identity . k))  -- | A mapping from 'Text' record field labels to the corresponding -- 'SomeField' for that record.

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# language CPP #-}  -- | Helpers for generating instances of the 'Record' type class. --@@ -134,22 +134,20 @@     fieldConstructors =       map (\(n, t) -> (mkConstrFieldName n, t)) names'types -  mkAllFields <- pure $-    ValD-      (VarP 'allFields)-      (NormalB $ ListE (map (AppE (ConE 'SomeField) . ConE . fst) fieldConstructors))-      []-   mkTabulateRecord <- do     fromFieldName <- newName "fromField"-    body <- pure $-      RecConE recordCon $-        map-          (\(n, _) -> (n, VarE fromFieldName `AppE` ConE (mkConstrFieldName n)))-          names'types+    let body =+            List.foldl'+                (\acc (n, _) ->+                    VarE '(<*>)+                        `AppE` acc+                        `AppE` (VarE fromFieldName `AppE` ConE (mkConstrFieldName n))+                )+                (VarE 'pure `AppE` ConE recordCon)+                names'types      pure $-      FunD 'tabulateRecord+      FunD 'tabulateRecordA         [ Clause [VarP fromFieldName] (NormalB body) []         ] @@ -197,7 +195,6 @@               fieldConstrs               []           , recordFieldLensDec-          , mkAllFields           , mkTabulateRecord           , mkRecordFieldLabel           ]

@@ -1,10 +1,12 @@-{-# language TypeApplications, StandaloneDeriving, ConstraintKinds, TemplateHaskell, DataKinds, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, GADTs #-}+{-# language PolyKinds, LambdaCase, TypeApplications, RankNTypes, StandaloneDeriving, ConstraintKinds, TemplateHaskell, DataKinds, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, GADTs #-}+{-# options_ghc -Wall #-} module Main where  import Prairie  import Data.Aeson import Control.Monad+import Control.Lens  data User = User { name :: String, age :: Int }   deriving Eq@@ -15,22 +17,73 @@  example = User "Alice" 30 +data T a = T { x :: a, y :: Int }++instance Record (T a) where+    data Field (T a) t where+        TX :: Field (T a) a+        TY :: Field (T a) Int++    recordFieldLens = \case+        TX -> lens x (\o n -> o { x = n })+        TY -> lens y (\o n -> o { y = n })++    tabulateRecordA f = T <$> f TX <*> f TY++    recordFieldLabel = \case+        TX -> "TX"+        TY -> "TY"+++class PolyLens t where+    polyLens :: (forall x. Field (t x) x) -> Lens (t a) (t b) a b++instance PolyLens T where+    polyLens = \case+        TX -> lens x (\o n -> o { x = n }) :: Lens (T a) (T b) a b++type family FieldLens (a :: *) (p :: *) (f :: * -> *) where+    FieldLens (Field (t x) x) y f = LensLike f (t x) (t y) x y+    FieldLens (Field (t x) y) y f = LensLike f (t x) (t x) y y+ assert :: String -> Bool -> IO () assert message success = unless success (error message)  main :: IO () main = do-  assert "getField" $ getRecordField UserName example == "Alice"-  assert "setField" $ setRecordField UserAge 32 example == User "Alice" 32-  assert "label" $ recordFieldLabel UserAge == "age"-  assert "label" $ recordFieldLabel UserName == "name"+    assert "getField" $ getRecordField UserName example == "Alice"+    assert "setField" $ setRecordField UserAge 32 example == User "Alice" 32+    assert "label" $ recordFieldLabel UserAge == "age"+    assert "label" $ recordFieldLabel UserName == "name" -  assert "update json" $-    encode (diffRecord example (setRecordField UserName "Bob" example))-    ==-    "[{\"field\":\"name\",\"value\":\"Bob\"}]"+    let t :: T Int+        t = T 3 2 -  assert "decode update" $-    decode "[{\"field\":\"name\",\"value\":\"Bob\"}]"-    ==-    Just [SetField UserName "Bob"]+        t' :: T Char+        t' = t & polyLens TX .~ 'a'++    assert "update json" $+        encode (diffRecord example (setRecordField UserName "Bob" example))+        ==+        "[{\"field\":\"name\",\"value\":\"Bob\"}]"++    assert "decode update" $+      decode "[{\"field\":\"name\",\"value\":\"Bob\"}]"+      ==+      Just [SetField UserName "Bob"]++    user' <-+      tabulateRecordA $ \case+          UserName ->+              print 10 >> pure "Matt"+          UserAge ->+              print 20 >> pure 33+    assert "tabulateRecordA" $+        user'+        ==+        User+            { name = "Matt"+            , age = 33+            }++