Massiv representations

So, I’m trying to do Advent of Code day 8 in massiv. I’m really struggling with the type wrangling involved, in particular the representations. I have the following:

import           Data.Massiv.Array    (Array, Comp (..), DL, Ix2 (..), Lower,
                                       Manifest, Source, U, S, Storable, Dimension (..), D, B)
import qualified Data.Massiv.Array    as A
import           Data.Massiv.Vector   (Vector)

-- [snip]

arrScan ∷ (A.Index ix, Source rep e, Manifest rep2 s)
        ⇒ (s → e → s) → s → Array rep ix e → Array rep2 ix s
arrScan f z = flip evalState z . A.traverseA (\x ->
  state $ \s -> let s' = f s x in (s', s'))

-- eg [1,2,2,3] -> [True, True, False, True]
markIncreases ∷ (Ord a, Bounded a, Manifest rep2 Bool, Source rep1 a)
              ⇒ Vector rep1 a
              → Vector rep2 Bool
markIncreases = flip evalState minBound . A.traverseA \x ->
  state \prev -> (prev < x, x)

treesVisibleFromLeft ∷ Vector B Int -> Vector B Bool
treesVisibleFromLeft = markIncreases . arrScan max minBound

And I’m getting this type error:

src/Day08.hs:57:24: error:
    • Ambiguous type variable ‘rep10’ arising from a use of ‘markIncreases’
      prevents the constraint ‘(Source rep10 Int)’ from being solved.
      Probable fix: use a type annotation to specify what ‘rep10’ should be.
      These potential instances exist:
        instance Source D e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Delayed.Pull’
        instance Source B e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Manifest.Boxed’
        instance Source A.BL e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Manifest.Boxed’
        ...plus four others
        (use -fprint-potential-instances to see them all)
    • In the first argument of ‘(.)’, namely ‘markIncreases’
      In the expression: markIncreases . arrScan max minBound
      In an equation for ‘treesVisibleFromLeft’:
          treesVisibleFromLeft = markIncreases . arrScan max minBound
   |
57 | treesVisibleFromLeft = markIncreases . arrScan max minBound
   |                        ^^^^^^^^^^^^^
src/Day08.hs:57:40: error:
    • Ambiguous type variable ‘rep10’ arising from a use of ‘arrScan’
      prevents the constraint ‘(Manifest rep10 Int)’ from being solved.
      Probable fix: use a type annotation to specify what ‘rep10’ should be.
      These potential instances exist:
        instance Manifest B e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Manifest.Boxed’
        instance Manifest A.BL e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Manifest.Boxed’
        instance NFData e => Manifest A.BN e
          -- Defined in ‘massiv-1.0.2.0:Data.Massiv.Array.Manifest.Boxed’
        ...plus three others
        (use -fprint-potential-instances to see them all)
    • In the second argument of ‘(.)’, namely ‘arrScan max minBound’
      In the expression: markIncreases . arrScan max minBound
      In an equation for ‘treesVisibleFromLeft’:
          treesVisibleFromLeft = markIncreases . arrScan max minBound
   |
57 | treesVisibleFromLeft = markIncreases . arrScan max minBound
   |

I’m very confused by this. I don’t understand what rep10 refers to. B is an instance of both Source and Manifest. What does the type error mean, and how do I resolve it?

Suggestions for unrelated code improvements also welcome

I figured it out. The ambiguity was in the type of the intermediate vector - the output of the scan and the input of the markIncreases

treesVisibleFromLeft ∷ Vector B Int -> Vector B Bool
treesVisibleFromLeft treeline = markIncreases scanned
  where
    scanned = arrScan max minBound $ treeline :: Vector B Int

Is there an ergonomic way to still use (.), perhaps with typeapplications?

Maybe you don’t need arrScan or markIncreases to be so polymorphic? How about restricting their type signatures? For example, changing the signature of markIncreases to:

markIncreases ∷ (Ord a, Bounded a, Manifest rep2 Bool)
              ⇒ Vector B a -- replaced rep1 with B here
              → Vector rep2 Bool

or going even further:

markIncreases ∷ Vector B Int → Vector B Bool

If you do need the polymorphic versions, you could use a type annotation instead:

treesVisibleFromLeft = 
  (markIncreases ∷ Vector B Int → Vector B Bool) . arrScan max minBound
1 Like

The most ergonomic way to specify the intermediate type is using a type application on id:

treesVisibleFromLeft = 
  markIncreases . id @(Vector B Int) . arrScan max minBound
2 Likes