LL1.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingVia #-}

module LL1 where

import Data.Functor.Alt (Alt ((<!>)))
import Data.Functor.Product (Product)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable)

newtype Empty e t a = Empty Bool
  deriving stock (Functor)

instance Applicative (Empty e t) where
  {-# INLINEABLE pure #-}
  pure _ = Empty True
  {-# INLINEABLE (<*>) #-}
  Empty b <*> Empty b' = Empty (b && b')

-- TODO: Laws vis a vis Applicative?
instance Alt (Empty e t) where
  {-# INLINEABLE (<!>) #-}
  Empty b <!> Empty b' = Empty (b || b')

newtype First e t a = First (HashSet t)
  deriving stock (Functor)

-- TODO: Laws vis a vis Applicative?
instance (Eq t, Hashable t) => Alt (First e t) where
  {-# INLINEABLE (<!>) #-}
  First hs <!> First hs' = First (hs <> hs')

newtype EmFirst e t a = EmFirst (Product (Empty e t) (First e t) a)
  deriving stock (Functor)
  deriving (Alt) via (Product (Empty e t) (First e t))
  
{- DerivingVia blows up as so:

src/LL1.hs:35:13: error:
    • Couldn't match type ‘Product (Empty e t) (First e t)’
                     with ‘EmFirst e t’
        arising from the coercion of the method ‘Data.Functor.Alt.many’
          from type ‘forall a.
                     Applicative (Product (Empty e t) (First e t)) =>
                     Product (Empty e t) (First e t) a
                     -> Product (Empty e t) (First e t) [a]’
            to type ‘forall a.
                     Applicative (EmFirst e t) =>
                     EmFirst e t a -> EmFirst e t [a]’
    • When deriving the instance for (Alt (EmFirst e t))
   |
35 |   deriving (Alt) via (Product (Empty e t) (First e t))
   |             ^^^

src/LL1.hs:35:13: error:
    • Couldn't match type ‘Product (Empty e t) (First e t)’
                     with ‘EmFirst e t’
        arising from the coercion of the method ‘Data.Functor.Alt.some’
          from type ‘forall a.
                     Applicative (Product (Empty e t) (First e t)) =>
                     Product (Empty e t) (First e t) a
                     -> Product (Empty e t) (First e t) [a]’
            to type ‘forall a.
                     Applicative (EmFirst e t) =>
                     EmFirst e t a -> EmFirst e t [a]’
    • When deriving the instance for (Alt (EmFirst e t))
   |
35 |   deriving (Alt) via (Product (Empty e t) (First e t))
   |             ^^^
   -}