fcf-composite 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+186/−5 lines, 5 filesdep +fcf-compositedep +tastydep +tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: fcf-composite, tasty, tasty-hunit, vinyl

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +2/−4
• fcf-composite.cabal +21/−1
• src/Composite/Fcf.hs +70/−0
• test/Spec.hs +89/−0

@@ -1,5 +1,9 @@ # Changelog for fcf-composite +## v0.1.1.0++* Add `difference`, `union` and `intersection` operators.+ ## v0.1.0.0  * Add `ToComposite` and `FromComposite` FCF expressions.

@@ -1,6 +1,6 @@ # fcf-composite -Fcf support for [composite](https://hackage.haskell.org/package/composite-base) records. This gives bidirection between a composite+[first-class-families](https://hackage.haskell.org/package/first-class-families) support for [composite](https://hackage.haskell.org/package/composite-base) records. This gives bidirection between a composite style `[s :-> a]` and `MapC s a` from [fcf-containers](https://hackage.haskell.org/package/fcf-containers). @@ -21,6 +21,4 @@ myRec = "foo" :*: RNil -- checks! ``` -Note: Since `ToComposite` and `FromComposite` use `ToList` and `FromList` from-Fcf.Data.MapC, then the fields will always be returned in alphabetical order-according to the symbol name, so you may need to use `rcast`.+Note: The ordering of the fields is predictable, but not obvious and commutations matter, so you may need to use rcast liberally.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           fcf-composite-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Type-level computation for composite using first-class-families. description:    Type-level computation for composite using first-class-families. category:       Composite, Types@@ -35,4 +35,24 @@     , composite-base >=0.7.0.0 && <0.8     , fcf-containers >=0.5.0 && <0.7     , first-class-families >=0.8.0.0 && <0.9+    , vinyl >=0.13.0 && <0.14+  default-language: Haskell2010++test-suite fcf-composite-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_fcf_composite+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , composite-base >=0.7.0.0 && <0.8+    , fcf-composite+    , fcf-containers >=0.5.0 && <0.7+    , first-class-families >=0.8.0.0 && <0.9+    , tasty+    , tasty-hunit+    , vinyl >=0.13.0 && <0.14   default-language: Haskell2010

@@ -1,4 +1,8 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -11,39 +15,105 @@     Union,     Difference,     Intersection,+    difference,+    union,+    intersection,   ) where  import Composite.Record import Data.Kind+import Data.Vinyl+import Data.Vinyl.Lens+import Data.Vinyl.TypeLevel as V import Fcf import qualified Fcf.Data.MapC import GHC.TypeLits +-- | Turn a single `s :-> a` into an `'(s, a)`+--+-- @since 0.1.0.0 data FromCompositeS :: Type -> Exp (Symbol, Type)  type instance Eval (FromCompositeS (s :-> x)) = '(s, x) +-- | Turn a list of `(s -> a)` into a `MapC s a`+--+-- @since 0.1.0.0 data FromComposite :: [Type] -> Exp (Fcf.Data.MapC.MapC Symbol Type)  type instance Eval (FromComposite x) = Eval (Fcf.Data.MapC.FromList =<< Fcf.Map FromCompositeS x) +-- | Turn a single `(s, a)` into a `s :-> a`+--+-- @since 0.1.0.0 data ToCompositeS :: (Symbol, Type) -> Exp Type  type instance Eval (ToCompositeS '(s, x)) = s :-> x +-- | Turn a `MapC s a` into a list of `(s :-> a)`+--+-- @since 0.1.0.0 data ToComposite :: Fcf.Data.MapC.MapC Symbol Type -> Exp [Type]  type instance Eval (ToComposite x) = Eval (Fcf.Map ToCompositeS =<< Fcf.Data.MapC.ToList x) +-- | Difference+--+-- @since 0.1.0.0 data Difference :: [Type] -> [Type] -> Exp [Type]  type instance Eval (Difference xs ys) = Eval (ToComposite =<< Fcf.Data.MapC.Difference (Eval (FromComposite xs)) (Eval (FromComposite ys))) +-- | Difference+--+-- @since 0.1.0.0 data Union :: [Type] -> [Type] -> Exp [Type]  type instance Eval (Union xs ys) = Eval (ToComposite =<< Fcf.Data.MapC.Union (Eval (FromComposite xs)) (Eval (FromComposite ys))) +-- | Intersection+--+-- @since 0.1.0.0 data Intersection :: [Type] -> [Type] -> Exp [Type]  type instance Eval (Intersection xs ys) = Eval (ToComposite =<< Fcf.Data.MapC.Intersection (Eval (FromComposite xs)) (Eval (FromComposite ys)))++-- | Take the difference of two records by casting to the result of `Difference`.+--+-- @since 0.1.1.0+difference ::+  forall f xs ys zs.+  ( zs ~ Eval (Difference xs ys),+    zs ⊆ (xs V.++ ys)+  ) =>+  Rec f xs ->+  Rec f ys ->+  Rec f zs+difference x y = rcast @zs (x <+> y)++-- | Take the union of two records by casting to the result of `Union`.+--+-- @since 0.1.1.0+union ::+  forall f xs ys zs.+  ( zs ~ Eval (Union xs ys),+    zs ⊆ (xs V.++ ys)+  ) =>+  Rec f xs ->+  Rec f ys ->+  Rec f zs+union x y = rcast @zs (x <+> y)++-- | Take the intersection of two records by casting to the result of `Intersection`.+--+-- @since 0.1.1.0+intersection ::+  forall f xs ys zs.+  ( zs ~ Eval (Intersection xs ys),+    zs ⊆ (xs V.++ ys)+  ) =>+  Rec f xs ->+  Rec f ys ->+  Rec f zs+intersection x y = rcast @zs (x <+> y)

@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralisedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Main (main) where++import Composite+import Composite.Fcf+import Composite.TH+import Data.Functor.Contravariant+import Data.Functor.Identity+import Data.Vinyl+import Test.Tasty+import Test.Tasty.HUnit++withLensesAndProxies+  [d|+    type A = "a" :-> String++    type B = "b" :-> Int++    type C = "c" :-> ()++    type D = "d" :-> (String, Int)+    |]++type RecA = Record '[A, B, C]++type RecB = Record '[B, C, D]++type RecDiffAB = Record '[A]++type RecDiffBA = Record '[D]++type RecUnionAB = Record '[A, B, C, D]++type RecIntersectionAB = Record '[B, C]++recA :: RecA+recA = "foo" :*: 5 :*: () :*: RNil++recB :: RecB+recB = 5 :*: () :*: ("bar", 4) :*: RNil++recDiffAB :: RecDiffAB+recDiffAB = "foo" :*: RNil++recDiffBA :: RecDiffBA+recDiffBA = ("bar", 4) :*: RNil++recUnionAB :: RecUnionAB+recUnionAB = "foo" :*: 5 :*: () :*: ("bar", 4) :*: RNil++recIntersectionAB :: RecIntersectionAB+recIntersectionAB = 5 :*: () :*: RNil++tests :: TestTree+tests =+  testGroup+    "Casting operations"+    [ testCase "difference" $ do+        let x = difference recA recB+        assertEqual "" recDiffAB x+        let x = difference recB recA+        assertEqual "" recDiffBA x,+      testCase "union" $ do+        let x = recA `union` recB+        assertEqual "" recUnionAB (rcast x)+        let x = recB `union` recA+        assertEqual "" recUnionAB x,+      testCase "intersection" $ do+        let x = intersection recA recB+        assertEqual "" recIntersectionAB x+        let x = intersection recB recA+        assertEqual "" recIntersectionAB x+    ]++main :: IO ()+main = defaultMain tests