prairie 0.0.2.1 → 0.0.3.0

raw patch · 6 files changed

+336/−41 lines, 6 filesdep +hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−1
• prairie.cabal +4/−1
• src/Prairie.hs +5/−1
• src/Prairie/Fold.hs +108/−0
• src/Prairie/Traverse.hs +66/−0
• test/Spec.hs +146/−38

@@ -1,8 +1,14 @@ # Changelog for prairie +## 0.0.3.0++- [#8](https://github.com/parsonsmatt/prairie/pull/8)+    - The `Prairie.Fold` module is introduced, allowing you to fold records.+    - The `Prairie.Traverse` module is introduced, allowing you to traverse over records.+ ## 0.0.2.1 -- [#3](https://github.com/parsonsmatt/prairie/pull/6)+- [#6](https://github.com/parsonsmatt/prairie/pull/6)     - Bump upper bound for `TemplateHaskell`, supporting up to GHC 9.8     - Fix string literals in docs that were quoted as module names 

@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           prairie-version:        0.0.2.1+version:        0.0.3.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@@ -27,6 +27,8 @@       Prairie.Class       Prairie.Update       Prairie.Diff+      Prairie.Fold+      Prairie.Traverse       Prairie.TH    build-depends:@@ -87,4 +89,5 @@     , prairie     , aeson     , lens+    , hspec   default-language: Haskell2010

@@ -5,10 +5,14 @@     ( module Prairie.Class     , module Prairie.Update     , module Prairie.Diff+    , module Prairie.Fold+    , module Prairie.Traverse     , module Prairie.TH     ) where  import Prairie.Class-import Prairie.Update import Prairie.Diff+import Prairie.Fold import Prairie.TH+import Prairie.Traverse+import Prairie.Update

@@ -0,0 +1,108 @@+-- | This module shows you how to fold a 'Record'.+--+-- These utilities are based on 'recordToFieldList', which converts+-- a 'Record' into a 'SomeFieldWithValue'. Then, 'foldRecord' unpacks that+-- GADT for you, which allows you to know the type of the field and combine+-- them.+--+-- @since 0.0.3.0+module Prairie.Fold where++import Control.Monad (foldM)+import Prairie.Class+import Data.List (foldl')++-- | A datatype containing a 'Field' along with a value for that field.+--+-- @since 0.0.3.0+data SomeFieldWithValue rec where+    SomeFieldWithValue :: Field rec a -> a -> SomeFieldWithValue rec++-- | Convert a 'Record' into a list of the records fields paired with the+-- value for that record.+--+-- @since 0.0.3.0+recordToFieldList :: forall rec. (Record rec) => rec -> [SomeFieldWithValue rec]+recordToFieldList rec =+    fmap+        (\(SomeField field) ->+            SomeFieldWithValue field (getRecordField field rec)+        )+        (allFields @rec)++-- | Fold over the fields of a record to produce a final result.+--+-- The function parameter accepts the @'Field' rec ty@, a value in the+-- record, and the accumulator. Example:+--+-- @+-- 'foldRecord'+--      (\\ val acc field ->+--          case field of+--              UserName ->+--                  length val + acc+--              UserAge ->+--                  val + acc+--      )+--      0+--      User { userName = \"Matt\", userAge = 35 }+-- @+--+-- The paramater list is given to enable 'LambdaCase' nicety:+--+-- @+-- 'foldRecord'+--      (\\val acc -> \\case+--          UserName ->+--              length val + acc+--          UserAge ->+--              val + acc+--      )+-- @+--+-- @since 0.0.3.0+foldRecord+    :: forall rec r+     . (Record rec)+    => (forall ty. ty -> r -> Field rec ty -> r)+    -> r+    -> rec+    -> r+foldRecord k init rec =+    foldl'+        (\acc (SomeFieldWithValue field value) ->+            k value acc field+        )+        init+        (recordToFieldList rec)++-- | Fold over a 'Record' with a monadic action.+--+-- @since 0.0.3.0+foldMRecord+    :: forall rec m r+     . (Record rec, Monad m)+    => (forall ty. ty -> r -> Field rec ty -> m r)+    -> r+    -> rec+    -> m r+foldMRecord k init rec =+    foldM+        (\acc (SomeFieldWithValue field value) ->+            k value acc field+        )+        init+        (recordToFieldList rec)++-- | Convert each field of a 'Record' into a monoidal value and combine+-- them together using 'mappend'.+--+-- @since 0.0.3.0+foldMapRecord+    :: forall rec m+    . (Record rec, Monoid m)+    => (forall ty. ty -> Field rec ty -> m)+    -> rec+    -> m+foldMapRecord k rec =+    foldMap (\(SomeFieldWithValue f v) -> k v f) (recordToFieldList rec)

@@ -0,0 +1,66 @@+-- | This module shows how to 'traverse' over a 'Record', allowing you to+-- perform side-effects for each field and return a transformed value.+--+-- @since 0.0.3.0+module Prairie.Traverse where++import Data.List (foldl')+import Prairie.Class+import Control.Applicative (liftA2)+import Prairie.Fold++-- | Apply an effectful function over each field of a 'Record', producing+-- a new 'Record' in the process.+--+-- This example use increments a @User@s age and requests a new name.+--+-- @+-- happyBirthday :: User -> IO User+-- happyBirthday =+--     traverseRecord+--          (\\val field ->+--              case field of+--                  UserName -> do+--                      putStrLn $ "Current name is: " <> val+--                      putStrLn "Please input a new name: "+--                      getLine+--                  UserAge -> do+--                      putStrLn $ "Current age is " <> show val+--                      pure (val + 1)+--          )+-- @+--+-- If you only want to target a single field, you can use a wildcard match+-- and `pure`. This example also uses @LambdaCase@.+--+-- @+-- nameAtLeastOneCharacter :: User -> 'Maybe' User+-- nameAtLeastOneCharacter =+--      'traverseRecord'+--          (\val ->+--              \case+--                  UserName -> do+--                      'guard' ('length' val >= 1)+--                      'pure' val+--                  _ ->+--                      'pure' val+--          )+-- @+--+-- @since 0.0.3.0+traverseRecord+    :: forall rec f. (Record rec, Applicative f)+    => (forall ty. ty -> Field rec ty -> f ty)+    -> rec+    -> f rec+traverseRecord f init =+    foldl' k (pure init) (recordToFieldList init)+  where+    f' :: Field rec ty -> ty -> f (SomeFieldWithValue rec)+    f' field val =+        SomeFieldWithValue field <$> f val field+    k frec (SomeFieldWithValue field val) =+        liftA2+            (\(SomeFieldWithValue field' val') rec -> setRecordField field' val' rec)+            (f' field val)+            frec

@@ -1,23 +1,40 @@-{-# language PolyKinds, LambdaCase, TypeApplications, RankNTypes, StandaloneDeriving, ConstraintKinds, TemplateHaskell, DataKinds, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies, GADTs #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}  {-# options_ghc -Wall #-}+ module Main where  import Prairie -import Data.Aeson-import Control.Monad import Control.Lens+import Control.Monad+import Data.Aeson import Data.Kind (Type)+import Data.Monoid+import Test.Hspec  data User = User { name :: String, age :: Int }-  deriving Eq+  deriving (Show, Eq)  mkRecord ''User  deriving instance Eq (Field User a)+deriving instance Show (Field User a) -example = User "Alice" 30+exampleUser = User "Alice" 30  data T a = T { x :: a, y :: Int } @@ -48,44 +65,135 @@     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"+main = hspec $ do+    describe "Prairie" $ do+        it "getField" $ do+            getRecordField UserName exampleUser `shouldBe` "Alice"+        it "setField" $ do+            setRecordField UserAge 32 exampleUser `shouldBe` User { name = "Alice", age = 32 }+        it "label" $ do+            recordFieldLabel UserAge `shouldBe` "age"+        it "label" $ do+            recordFieldLabel UserName `shouldBe` "name" -    let t :: T Int-        t = T 3 2+        let t :: T Int+            t = T 3 2 -        t' :: T Char-        t' = t & polyLens TX .~ 'a'+            t' :: T Char+            t' = t & polyLens TX .~ 'a' -    assert "update json" $-        encode (diffRecord example (setRecordField UserName "Bob" example))-        ==-        "[{\"field\":\"name\",\"value\":\"Bob\"}]"+        it "update json" $+            encode (diffRecord exampleUser (setRecordField UserName "Bob" exampleUser))+            `shouldBe`+            "[{\"field\":\"name\",\"value\":\"Bob\"}]" -    assert "decode update" $-      decode "[{\"field\":\"name\",\"value\":\"Bob\"}]"-      ==-      Just [SetField UserName "Bob"]+        it "decode update" $+          decode "[{\"field\":\"name\",\"value\":\"Bob\"}]"+          `shouldBe`+          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-            }+        it "tabulateRecordA" $ do+            user' <-+              tabulateRecordA $ \case+                  UserName ->+                      print 10 >> pure "Matt"+                  UserAge ->+                      print 20 >> pure 33+            user'+                `shouldBe`+                User+                    { name = "Matt"+                    , age = 33+                    } +        describe "Fold" $ do+            describe "foldRecord" $ do+                it "can count the fields" $ do+                    foldRecord (\_val acc _field -> acc + 1) 0 exampleUser+                        `shouldBe`+                            2+                it "can distinguish fields" $ do+                    foldRecord+                        (\val acc field ->+                            case field of+                                UserName ->+                                    length val + acc+                                UserAge ->+                                    val + acc+                        )+                        (0 :: Int)+                        exampleUser+                        `shouldBe`+                            35 +            describe "foldMapRecord" $ do+                it "can count the fields" $ do+                    foldMapRecord (\_ _ -> Sum 1) exampleUser+                        `shouldBe`+                            Sum 2+                it "can combine strings" $ do+                    foldMapRecord+                        (\val ->+                            \case+                                UserName -> val+                                UserAge -> show val+                        )+                        exampleUser+                        `shouldBe`+                            ("Alice30" :: String)++        describe "Traverse" $ do+            it "can validate a record" $ do+                let validateField :: ty -> Field User ty -> Maybe ty+                    validateField val =+                        \case+                            UserName -> do+                                guard (length val >= 1)+                                pure val+                            UserAge -> do+                                guard (val >= 18)+                                pure val+                traverseRecord validateField exampleUser+                    `shouldBe`+                        Just User { name = "Alice", age = 30 }++                traverseRecord validateField User { name = "", age = 1 }+                    `shouldBe`+                        Nothing+++            it "can do either" $ do+                let validateField :: ty -> Field User ty -> Either String ty+                    validateField val =+                        \case+                            UserName -> do+                                if length val >= 1+                                    then pure val+                                    else Left "Name must be at least one character"+                            UserAge -> do+                                if val >= 18+                                    then pure val+                                    else Left "Age must be at least 18"++                traverseRecord validateField exampleUser+                    `shouldBe`+                        Right User { name = "Alice", age = 30 }++                traverseRecord validateField User { name = "", age = 1 }+                    `shouldBe`+                        Left "Age must be at least 18"++            it "can target one field" $ do+                traverseRecord+                    (\val ->+                        \case+                            UserName -> do+                                guard (length val >= 1)+                                pure val+                            _ ->+                                pure val+                    )+                    User { name = "", age = 30 }+                    `shouldBe`+                        Nothing