Commit cabafe34 authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

testsuite: Add test for #17423

parent a4ce26e0
Pipeline #12067 passed with stages
in 598 minutes and 44 seconds
{-# LANGUAGE Arrows, GADTs #-}
module Main where
import Control.Arrow
import Control.Category
import Prelude hiding (id, (.))
data DecoType a where
-- | Icons and colours for @False@ and @True@ respectively.
DecoBool :: Maybe (String, String) -> Maybe (Int, Int) -> DecoType Bool
-- | Icons and colours for ranges within type @a@.
DecoRange :: String -> DecoType a
-- Sub-dialog for designing decorated booleans.
decoBoolDialog :: Gadget (DecoType Bool) (DecoType Bool)
decoBoolDialog =
-- arr (\(DecoBool i c) -> (i, c)) >>> (icons *** colours) >>> arr (uncurry DecoBool)
proc (DecoBool i c) -> do -- Compiler panic in GHC 8.6.5.
i1 <- id -< i
c1 <- id -< c
returnA -< DecoBool i1 c1
data Gadget b c = Pure (b -> c)
instance Category Gadget where
id = Pure id
Pure g1 . Pure g2 = Pure $ g1 . g2
instance Arrow Gadget where
arr = Pure
first (Pure f) = Pure $ \(b, b1) -> (f b, b1)
main = putStrLn "Hello world."
......@@ -120,3 +120,4 @@ test('T14808', normal, compile, [''])
test('T15009', normal, compile, [''])
test('T15558', normal, compile, [''])
test('T16427', normal, compile_fail, [''])
test('T17423', expect_broken(17423), compile_and_run, [''])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment