[Haskell-cafe] How to speedup generically parsing sum types?

[Bas van Dijk]

For those who find this interesting. Here's the code of the BigSum benchmark
with a manual Generic instance with inlined 'from' and 'to':
https://gist.github.com/1336426

José, I was thinking about the following idea. Say GHC generates the
following instance for BigSum:

instance Generic BigSum where
  type Rep BigSum = D1 D1BigSum SumOfBigSum
  ...

type SumOfBigSum =
       (   (   (    C1 C1_0BigSum U1
               :+: (C1 C1_1BigSum U1 :+: C1 C1_2BigSum U1)
               )
           :+: (    C1 C1_3BigSum U1
               :+: (C1 C1_4BigSum U1 :+: C1 C1_5BigSum U1)
               )
           )
       :+: (   (    C1 C1_6BigSum U1
               :+: (C1 C1_7BigSum U1 :+: C1 C1_8BigSum U1)
               )
           :+: (    C1 C1_9BigSum  U1
               :+: (C1 C1_10BigSum U1 :+: C1 C1_11BigSum U1)
               )
           )
       )
  :+: (   (   (    C1 C1_12BigSum U1
              :+: (C1 C1_13BigSum U1 :+: C1 C1_14BigSum U1)
              )
          :+: (    C1 C1_15BigSum U1
              :+: (C1 C1_16BigSum U1 :+: C1 C1_17BigSum U1)
              )
          )
      :+: (   (    C1 C1_18BigSum U1
              :+: (C1 C1_19BigSum U1 :+: C1 C1_20BigSum U1)
              )
          :+: (   (C1 C1_21BigSum U1 :+: C1 C1_22BigSum U1)
              :+: (C1 C1_23BigSum U1 :+: C1 C1_24BigSum U1)
              )
          )
      )

It also generates the following function (or method): (I haven't
figured out the correct type yet. A correct version might need to use
type families or functional dependencies)

conPath :: String -> Maybe (C1 ? ? ? -> SumOfBigSum)
conPath "F01" = Just $ L1 . L1 . L1 . L1
conPath "F02" = Just $ L1 . L1 . L1 . R1 . L1
conPath "F03" = Just $ L1 . L1 . L1 . R1 . R1
conPath "F04" = Just $ L1 . L1 . R1 . L1
conPath "F05" = Just $ L1 . L1 . R1 . R1 . L1
conPath "F06" = Just $ L1 . L1 . R1 . R1 . R1
conPath "F07" = Just $ L1 . R1 . L1 . L1
conPath "F08" = Just $ L1 . R1 . L1 . R1 . L1
conPath "F09" = Just $ L1 . R1 . L1 . R1 . R1
conPath "F10" = Just $ L1 . R1 . R1 . L1
conPath "F11" = Just $ L1 . R1 . R1 . R1 . L1
conPath "F12" = Just $ L1 . R1 . R1 . R1 . R1
conPath "F13" = Just $ R1 . L1 . L1 . L1
conPath "F14" = Just $ R1 . L1 . L1 . R1 . L1
conPath "F15" = Just $ R1 . L1 . L1 . R1 . R1
conPath "F16" = Just $ R1 . L1 . R1 . L1
conPath "F17" = Just $ R1 . L1 . R1 . R1 . L1
conPath "F18" = Just $ R1 . L1 . R1 . R1 . R1
conPath "F19" = Just $ R1 . R1 . L1 . L1
conPath "F20" = Just $ R1 . R1 . L1 . R1 . L1
conPath "F21" = Just $ R1 . R1 . L1 . R1 . R1
conPath "F22" = Just $ R1 . R1 . R1 . L1 . L1
conPath "F23" = Just $ R1 . R1 . R1 . L1 . R1
conPath "F24" = Just $ R1 . R1 . R1 . R1 . L1
conPath "F25" = Just $ R1 . R1 . R1 . R1 . R1
conPath _     = Nothing

conPath is given the name of the constructor. If it's a valid name it
will return a function that constructs a SumOfBigSum given the
corresponding constructor. Of course, since the types of the
constructors can vary (not in this case) coming up with a correct
implementation is a challenge.

Using conPath in my gParseJSON is easy:

instance (GFromJSON a, GFromJSON b) => GFromJSON (a :+: b) where
    gParseJSON (Object (M.toList -> [(key, val)])) =
        case conPath key of
          Nothing   -> mzero
          Just path -> path <$> gParseJSON val

    gParseJSON v = typeMismatch "sum (:+:)" v
    {-# INLINE gParseJSON #-}

I suspect this to be much more efficient.

Bas