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 +26/−2
- src/Composite.hs +8/−0
- src/Composite/Record.hs +111/−0
- test/Main.hs +8/−0
- test/RecordSpec.hs +47/−0
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)+