1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Define Listable instances for non-empty Unions.

This commit is contained in:
Rob Rix 2017-09-25 19:08:55 -04:00
parent 5ba29e6361
commit 468a874168
2 changed files with 10 additions and 1 deletions

View File

@ -165,6 +165,7 @@ test-suite test
, bifunctors , bifunctors
, bytestring , bytestring
, comonad , comonad
, effects
, filepath , filepath
, free , free
, Glob , Glob

View File

@ -1,4 +1,4 @@
{-# LANGUAGE DataKinds, TypeOperators #-} {-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Functor.Listable module Data.Functor.Listable
( Listable(..) ( Listable(..)
@ -40,6 +40,7 @@ import Data.Span
import Data.Text as T (Text, pack) import Data.Text as T (Text, pack)
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import Data.These import Data.These
import Data.Union
import Diff import Diff
import Patch import Patch
import Renderer.TOC import Renderer.TOC
@ -283,6 +284,13 @@ instance Listable recur => Listable (Syntax recur) where
tiers = tiers1 tiers = tiers1
instance (Listable1 f, Listable1 (Union (g ': fs))) => Listable1 (Union (f ': g ': fs)) where
liftTiers tiers = (inj `mapT` ((liftTiers :: [Tier a] -> [Tier (f a)]) tiers)) \/ (weaken `mapT` ((liftTiers :: [Tier a] -> [Tier (Union (g ': fs) a)]) tiers))
instance Listable1 f => Listable1 (Union '[f]) where
liftTiers tiers = inj `mapT` ((liftTiers :: [Tier a] -> [Tier (f a)]) tiers)
instance Listable1 Gram where instance Listable1 Gram where
liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram