Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

All2 c xss should imply All SListI xss #73

Open
mniip opened this issue Aug 19, 2018 · 12 comments
Open

All2 c xss should imply All SListI xss #73

mniip opened this issue Aug 19, 2018 · 12 comments
Milestone

Comments

@mniip
Copy link

mniip commented Aug 19, 2018

This came up during ekmett's haskell stream: There's no nice way to do a double fold on an All2 c xss => xss because the type system doesn't know the inner lists are lists, i.e All SListI xss. The workaround was to write direct recursion on nil/cons cases.

@phadej
Copy link
Contributor

phadej commented Aug 20, 2018

The implication should indeed by there, but what you mean by the double fold? For example:

garbitrary :: forall a. (Generic a, All2 Arbitrary (Code a)) => Gen a
garbitrary = liftM to $ hsequence =<< elements (apInjs_POP $ hcpure p arbitrary)
  where
    p :: Proxy Arbitrary
    p = Proxy

http://hackage.haskell.org/package/generics-sop-0.3.2.0/docs/Generics-SOP-NS.html#v:apInjs_POP

Or was Edward playing with hcfoldMap ?

@phadej
Copy link
Contributor

phadej commented Aug 20, 2018

In other words, what's the code you want to write, but you cannot? (so it can be added as a test).

@mniip
Copy link
Author

mniip commented Aug 20, 2018

Double fold a-la foldr (f2 :: b -> c -> c) (z2 :: c) . map (foldr (f1 :: a -> b -> b) (z1 :: b)) :: [[a]] -> c. I.e with different functions on the outer and inner NP of the POP.

@phadej
Copy link
Contributor

phadej commented Aug 20, 2018

I'd prefer a code snippet I can insert into an editor and see it fail.

@mniip
Copy link
Author

mniip commented Aug 20, 2018

A vast simplification of the code is:

{-# LANGUAGE TypeApplications, RankNTypes, ScopedTypeVariables, DefaultSignatures, FlexibleContexts, AllowAmbiguousTypes, PolyKinds, DataKinds #-}

import GHC.Generics as GHC
import Generics.SOP
import Generics.SOP.Constraint
import Generics.SOP.GGP

class Cnt a where
    cnt :: Int
    default cnt :: (GHC.Generic a, GFrom a, All2 Cnt (GCode a)) => Int
    cnt = gcnt @(GCode a)

gcnt :: forall xss. (All SListI xss, All2 Cnt xss) => Int
gcnt = sum $ hcollapse np
    where
        np :: NP (K Int) xss
        np = hcmap (Proxy @SListI) (\xs -> K (product $ hcollapse xs)) npnp

        npnp :: NP (NP (K Int)) xss
        npnp = unPOP $ hcpure (Proxy @Cnt) kcnt

        kcnt :: forall a. Cnt a => K Int a
        kcnt = K (cnt @a)

NB: inner fold uses product, outer fold uses sum.

@phadej
Copy link
Contributor

phadej commented Aug 20, 2018

diff --git a/src/Generics/SOP/Constraint.hs b/src/Generics/SOP/Constraint.hs
index 321677e..0252cbf 100644
--- a/src/Generics/SOP/Constraint.hs
+++ b/src/Generics/SOP/Constraint.hs
@@ -77,8 +77,8 @@ type SListI2 = All SListI
 -- means that 'f' can assume that all elements of the sum
 -- of product satisfy 'Eq'.
 --
-class (AllF (All f) xss, SListI xss) => All2 f xss
-instance (AllF (All f) xss, SListI xss) => All2 f xss
+class (AllF (All f) xss, All SListI xss, SListI xss) => All2 f xss
+instance (AllF (All f) xss, All SListI xss, SListI xss) => All2 f xss
 --
 -- NOTE:
 --
diff --git a/src/Generics/SOP/Dict.hs b/src/Generics/SOP/Dict.hs
index a2cf88a..656fbe3 100644
--- a/src/Generics/SOP/Dict.hs
+++ b/src/Generics/SOP/Dict.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- | Explicit dictionaries.
 --
 -- When working with compound constraints such as constructed
@@ -141,8 +142,16 @@ unAll2 Dict = Dict
 --
 -- @since 0.2
 --
-all2 :: Dict (All (All c)) xss -> Dict (All2 c) xss
-all2 Dict = Dict
+all2 :: forall c xss. Dict (All (All c)) xss -> Dict (All2 c) xss
+all2 Dict = case aux :: Dict (All SListI) xss of Dict -> Dict
+  where
+    aux :: forall yss. All (All c) yss => Dict (All SListI) yss
+    aux = case sList :: SList yss of
+        SNil  -> Dict
+        SCons -> aux'
+
+    aux' :: forall ys yss. (All c ys, All (All c) yss) => Dict (All SListI) (ys ': yss)
+    aux' = case aux :: Dict (All SListI) yss of Dict -> Dict

Solves the issue so the modified example

{-# LANGUAGE TypeApplications, RankNTypes, ScopedTypeVariables, DefaultSignatures, FlexibleContexts, AllowAmbiguousTypes, PolyKinds, DataKinds #-}

import GHC.Generics as GHC
import Generics.SOP
import Generics.SOP.Constraint
import Generics.SOP.GGP

class Cnt a where
    cnt :: Int
    default cnt :: (GHC.Generic a, GFrom a, All2 Cnt (GCode a)) => Int
    cnt = gcnt @(GCode a)

-- note: no All SListI xss
gcnt :: forall xss. All2 Cnt xss => Int
gcnt = sum $ hcollapse np
    where
        np :: NP (K Int) xss
        np = hcmap (Proxy @SListI) (\xs -> K (product $ hcollapse xs)) npnp

        npnp :: NP (NP (K Int)) xss
        npnp = unPOP $ hcpure (Proxy @Cnt) kcnt

        kcnt :: forall a. Cnt a => K Int a
        kcnt = K (cnt @a)

compiles.


all2 becomes ugly. I'd be in favour of making changes and adding Cnt.hs into examples so e.g. solution to #32 would not-break it, but on opposite make this case nicer.

@mniip
Copy link
Author

mniip commented Aug 20, 2018

Ah yes sorry All SListI xss in gcnt's type was probably me copying a not-completely-edited file.

@phadej
Copy link
Contributor

phadej commented Aug 20, 2018

Another variant, which doesn't require changing generics-sop is to write double hcollapse as:

{-# LANGUAGE TypeApplications, RankNTypes, ScopedTypeVariables, DefaultSignatures, FlexibleContexts, AllowAmbiguousTypes, PolyKinds, DataKinds #-}

import GHC.Generics as GHC
import Generics.SOP
import Generics.SOP.Constraint
import Generics.SOP.GGP

class Cnt a where
    cnt :: Int
    default cnt :: (GHC.Generic a, GFrom a, All2 Cnt (GCode a)) => Int
    cnt = gcnt @(GCode a)

gcnt :: forall xss. All2 Cnt xss => Int
gcnt = sum $ hcollapse np
    where
        -- Another variant: @SListI -> All Cnt
        np :: NP (K Int) xss
        np = hcmap (Proxy @(All Cnt)) (\xs -> K (product $ hcollapse xs)) npnp

        npnp :: NP (NP (K Int)) xss
        npnp = unPOP $ hcpure (Proxy @Cnt) kcnt

        kcnt :: forall a. Cnt a => K Int a
        kcnt = K (cnt @a)

@kosmikus
Copy link
Member

Yes, @phadej 's last variant is what I would suggest to use here. I agree that one can argue that the suggested implication should directly hold. I'd rather replace SListI with All Top in the long term though.

@kosmikus
Copy link
Member

See #32.

@kosmikus kosmikus added this to the 0.4.1 milestone Sep 24, 2018
@kosmikus
Copy link
Member

Somewhat related: with quantified constraints, we can say

class (..., forall d . (forall x . c x => d x) => All d xs) => All c xs

in replacement of

class (..., All SListI xs) => All c xs

and it will give us better superclass behaviour for All. We'll have to wait until we can make GHC 8.6 the lower dependency bound of the library though.

@kosmikus
Copy link
Member

kosmikus commented May 4, 2019

With #32 done, I think the quantified constraint would be the main improvement we could make here, but I'm not yet prepared to move to 8.6 as minimum.

@kosmikus kosmikus modified the milestones: 0.4.1, 0.6 May 4, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

3 participants