github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Define Listable instances for non-empty Unions.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic-diff.cabal
View File

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

10
test/Data/Functor/Listable.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Functor.Listable
( Listable(..)
@ -40,6 +40,7 @@ import Data.Span
import Data.Text as T (Text, pack)
import qualified Data.Text.Encoding as T
import Data.These
import Data.Union
import Diff
import Patch
import Renderer.TOC
@ -283,6 +284,13 @@ instance Listable recur => Listable (Syntax recur) where
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
liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram