packages feed

composite-base 0.1.1.0 → 0.2.0.0

raw patch · 5 files changed

+200/−2 lines, 5 filesdep +QuickCheckdep +composite-basedep +hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, composite-base, hspec

API changes (from Hackage documentation)

+ Composite.Record: Col :: a -> (:->) a
+ Composite.Record: Identity :: a -> Identity a
+ Composite.Record: [getCol] :: (:->) a -> a
+ Composite.Record: data Rec u (a :: u -> *) (b :: [u]) :: forall u. (u -> *) -> [u] -> *
+ Composite.Record: infixr 5 :^:
+ Composite.Record: newtype (:->) (s :: Symbol) a :: Symbol -> * -> *
+ Composite.Record: newtype Identity a :: * -> *
+ Composite.Record: rlens :: (Functor g, RElem (s :-> a) rs (RIndex (s :-> a) rs), Functor g) => proxy (s :-> a) -> (a -> g a) -> Rec Identity rs -> g (Rec Identity rs)
+ Composite.Record: rlens' :: (Functor f, Functor g, RElem (s :-> a) rs (RIndex (s :-> a) rs), Functor g) => proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs)
+ Composite.Record: type Record = Rec * Identity

Files

composite-base.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           composite-base-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Shared utilities for composite-* packages. description:    Shared helpers for the various composite packages. category:       Records@@ -18,7 +18,7 @@ library   hs-source-dirs:       src-  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NoImplicitPrelude OverloadedStrings PolyKinds ScopedTypeVariables StrictData TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NoImplicitPrelude OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StrictData TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns   ghc-options: -Wall -O2   build-depends:       base >= 4.7 && < 5@@ -29,6 +29,30 @@     , text     , vinyl   exposed-modules:+      Composite       Composite.Base+      Composite.Record       Composite.TH+  default-language: Haskell2010++test-suite composite-base-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test+  default-extensions: DataKinds FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NoImplicitPrelude OverloadedStrings PatternSynonyms PolyKinds ScopedTypeVariables StrictData TemplateHaskell TupleSections TypeFamilies TypeOperators ViewPatterns+  ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans+  build-depends:+      base >= 4.7 && < 5+    , Frames+    , basic-prelude+    , template-haskell+    , lens+    , text+    , vinyl+    , QuickCheck+    , composite-base+    , hspec+  other-modules:+      RecordSpec   default-language: Haskell2010
+ src/Composite.hs view
@@ -0,0 +1,8 @@+module Composite+  ( module Composite.Base+  , module Composite.Record+  ) where++import Composite.Base+import Composite.Record+
+ src/Composite/Record.hs view
@@ -0,0 +1,111 @@+module Composite.Record+  ( Rec, Record, Identity(Identity)+  , pattern (:*:), pattern (:^:), pattern Nil, pattern Val+  , (:->)(Col, getCol)+  , rlens, rlens'+  ) where++import BasicPrelude+import Data.Vinyl (Rec((:&), RNil))+import qualified Data.Vinyl as Vinyl+import Data.Vinyl.Functor (Identity(Identity))+import Data.Vinyl.Lens (RElem)+import Data.Vinyl.TypeLevel (RIndex)+import Frames (Record, (:->)(Col, getCol))+import qualified Frames++-- |Pattern synonym equivalent to the empty record 'RNil'.+--+-- This pattern is bidirectional meaning you can use it either a pattern or as a constructor, e.g.+--+-- @+--   let Nil = Nil :: 'Record' '[]+-- @+--+-- is valid.+pattern Nil :: Vinyl.Rec f '[]+pattern Nil = RNil++-- |Bidirectional pattern matching the first field of a record using ':->' values and the 'Identity' functor.+--+-- This pattern is bidirectional meaning you can use it either as a pattern or a constructor, e.g.+--+-- @+--   let rec = 123 :*: Just "foo" :*: Nil+--       foo :*: bar :*: Nil = rec+-- @+--+-- Mnemonic: @*@ for products.+pattern (:*:) :: () => () => a -> Rec Identity rs -> Rec Identity (s :-> a ': rs)+pattern (:*:) a rs = Identity (Col a) :& rs+infixr 5 :*:++-- |Bidirectional pattern matching the first field of a record using ':->' values and any functor.+--+-- This pattern is bidirectional meaning you can use it either as a pattern or a constructor, e.g.+--+-- @+--   let rec = Just 123 :^: Just "foo" :^: Nil+--       Just foo :^: Just bar :^: Nil = rec+-- @+--+-- Mnemonic: @^@ for products (record) of products (functor).+pattern (:^:) :: Functor f => () => f a -> Rec f rs -> Rec f (s :-> a ': rs)+pattern (:^:) fa rs <- (map getCol -> fa) :& rs where+  (:^:) fa rs = map Col fa :& rs+infixr 5 :^:++-- |Bidirectional pattern unwrapping @Identity (s :-> a)@ to @a@.+pattern Val :: a -> Identity (s :-> a)+pattern Val a = Identity (Col a)++-- |Lens to a particular field of a record using the 'Identity' functor.+--+-- For example, given:+--+-- @+--   type FFoo = "foo" :-> Int+--   type FBar = "bar" :-> String+--   fBar_ :: Proxy FBar+--   fBar_ = Proxy+--+--   rec :: 'Rec' 'Identity' '[FFoo, FBar]+--   rec = 123 :*: "hello!" :*: Nil+-- @+--+-- Then:+--+-- @+--   view (rlens fBar_)               rec == "hello!"+--   set  (rlens fBar_) "goodbye!"    rec == 123 :*: "goodbye!" :*: Nil+--   over (rlens fBar_) (map toUpper) rec == 123 :*: "HELLO!"   :*: Nil+-- @+rlens :: (Functor g, RElem (s :-> a) rs (RIndex (s :-> a) rs), Functor g) => proxy (s :-> a) -> (a -> g a) -> Rec Identity rs -> g (Rec Identity rs)+rlens = Frames.rlens++-- |Lens to a particular field of a record using any functor.+--+-- For example, given:+--+-- @+--   type FFoo = "foo" :-> Int+--   type FBar = "bar" :-> String+--   fBar_ :: Proxy FBar+--   fBar_ = Proxy+--+--   rec :: 'Rec' 'Maybe' '[FFoo, FBar]+--   rec = Just 123 :^: Just "hello!" :^: Nil+-- @+--+-- Then:+--+-- @+--   view (rlens' fBar_)                      rec == Just "hello!"+--   set  (rlens' fBar_) Nothing              rec == Just 123 :^: Nothing       :^: Nil+--   over (rlens' fBar_) (fmap (map toUpper)) rec == Just 123 :^: Just "HELLO!" :^: Nil+-- @+rlens' :: (Functor f, Functor g, RElem (s :-> a) rs (RIndex (s :-> a) rs), Functor g) => proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs)+rlens' proxy f =+  Vinyl.rlens proxy $ \ (map getCol -> fa) ->+    map Col <$> f fa+
+ test/Main.hs view
@@ -0,0 +1,8 @@+import BasicPrelude+import RecordSpec (recordSuite)+import Test.Hspec (hspec)++main :: IO ()+main = hspec $ do+  recordSuite+
+ test/RecordSpec.hs view
@@ -0,0 +1,47 @@+module RecordSpec where++import BasicPrelude+import Composite.Record+import Composite.TH (withLensesAndProxies)+import Control.Lens (view, set, _Just)+import Test.Hspec (Spec, describe, it, shouldBe)++withLensesAndProxies [d|+  type FFoo = "foo" :-> Int+  type FBar = "bar" :-> String+  |]+type TestRec = '["foo" :-> Int, "bar" :-> String]++recordSuite :: Spec+recordSuite = do+  describe "Basic record utilities" $ do+    it "Supports construction and deconstruction of a Rec Identity" $ do+      let rec = 123 :*: "foo" :*: Nil :: Record TestRec+          foo :*: bar :*: Nil = rec+      foo `shouldBe` 123+      bar `shouldBe` "foo"++    it "Supports construction and deconstruction of a Rec f" $ do+      let rec = Just 123 :^: Nothing :^: Nil :: Rec Maybe TestRec+          Just foo :^: Nothing :^: Nil = rec+      foo `shouldBe` 123++    it "Supports pattern matching an Identity .: (:->)" $ do+      let val = Val (123 :: Int)+          Val i = val+      i `shouldBe` 123++    it "Supports lensing in a Rec Identity" $ do+      let rec = 123 :*: "foo" :*: Nil :: Record TestRec+      view (rlens fFoo_) rec `shouldBe` 123+      view (rlens fBar_) rec `shouldBe` "foo"+      set (rlens fFoo_) 321   rec `shouldBe` (321 :*: "foo" :*: Nil)+      set (rlens fBar_) "bar" rec `shouldBe` (123 :*: "bar" :*: Nil)++    it "Supports lensing in a Rec Maybe" $ do+      let rec = Just 123 :^: Nothing :^: Nil :: Rec Maybe TestRec+      view (rlens' fFoo_) rec `shouldBe` Just 123+      view (rlens' fBar_) rec `shouldBe` Nothing+      set (rlens' fFoo_ . _Just) 321   rec `shouldBe` (Just 321 :^: Nothing :^: Nil)+      set (rlens' fBar_ . _Just) "bar" rec `shouldBe` (Just 123 :^: Nothing :^: Nil)+