summer 0.3.5.0 → 0.3.6.0

raw patch · 3 files changed

+25/−10 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Data/Summer.hs +23/−8
• summer.cabal +1/−1
• test/Test.hs +1/−1

@@ -229,19 +229,34 @@   weaken = error "weaken base case: impossible by construction"   {-# INLINE CONLIKE weaken #-} -class UnorderedMatch xs ys where-  unorderedMatch :: Sum xs -> Matcher ys r+class UnorderedMatch xs matcher where+  unorderedMatch :: Sum xs -> matcher -instance UnorderedMatch '[] '[] where+instance UnorderedMatch '[] r where   unorderedMatch = error "unordered match base case: impossible by construction" -instance (Match ys, y `HasTagIn` xs, UnorderedMatch (Delete y xs) ys) => UnorderedMatch xs (y ': ys) where-  unorderedMatch :: forall r. Sum xs -> (y -> r) -> Matcher ys r+instance+  ( Result matcher ~ r+  , Match (Unmatcher matcher r)+  , Matcher (Unmatcher matcher r) r ~ matcher+  , y `HasTagIn` xs+  , UnorderedMatch  (Delete y xs) matcher+  ) => UnorderedMatch xs ((y -> r) -> matcher) where+  unorderedMatch :: Sum xs -> (y -> r) -> matcher   unorderedMatch uv@(UnsafeInj tag' x) f =     if tag' == tag @y @xs-      then override @ys @r (f (unsafeCoerce x)) $ unorderedMatch @(Delete y xs) @ys @r (unsafeForget @y uv)-      else unorderedMatch @(Delete y xs) @ys @r (unsafeForget @y uv)-  +      then override @(Unmatcher matcher r) @r (f (unsafeCoerce x)) $ unorderedMatch @(Delete y xs) @matcher (unsafeForget @y uv)+      else unorderedMatch @(Delete y xs) @matcher (unsafeForget @y uv)++-- | Returns the result type of the Scott encoding for the particular Sum's elements.+type family Result matcher :: Type where+  Result ((x -> r) -> matcher) = r+  Result r = r++-- | What types does this Scott encoding have in its Sum?+type family Unmatcher matcher r :: [Type] where+  Unmatcher r r = '[]+  Unmatcher ((x -> r) -> matcher) r = x ': Unmatcher matcher r  -- | The scott encoding of an extensible sum type family Matcher xs r :: Type where

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                summer-version:             0.3.5.0+version:             0.3.6.0 synopsis:            An implementation of extensible products and sums description:         An implementation of extensible products and sums. license:             MIT

@@ -186,4 +186,4 @@       require (apply @Show show x == "False") "apply does not work 0"     unorderedMatchTest = do       let x :: Sum '[Int, Bool] = Inj False-      require (unorderedMatch @_ @'[Bool, Int] x not (== 10)) "unordered match does not work 0"+      require (unorderedMatch x not (\(x :: Int) -> x == 10)) "unordered match does not work 0"