summaryrefslogtreecommitdiff
path: root/testsuite/tests/simplCore/should_compile/T17590.hs
blob: 4f668f32fac60135d4e3ba0a8b7ec948bdaf5998 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeOperators #-}
module Codec.Picture.Metadata where

import Control.DeepSeq( NFData( .. ) )
import Data.Typeable( (:~:)( Refl ) )
import Data.Word( Word16 )

data ExifTag
  = TagPhotometricInterpretation
  | TagUnknown !Word16
  deriving Eq

data ExifData = ExifNone

data Keys a where
  Exif        :: !ExifTag -> Keys ExifData
  Unknown     :: !String -> Keys Value

data Value

data Elem k =
  forall a. (Show a, NFData a) => !(k a) :=> a

keyEq :: Keys a -> Keys b -> Maybe (a :~: b)
keyEq a b = case (a, b) of
  (Unknown v1, Unknown v2) | v1 == v2 -> Just Refl
  (Exif t1, Exif t2) | t1 == t2 -> Just Refl
  _ -> Nothing

newtype Metadatas = Metadatas { getMetadatas :: [Elem Keys] }

lookup :: Keys a -> Metadatas -> Maybe a
lookup k = go . getMetadatas where
  go [] = Nothing
  go ((k2 :=> v) : rest) = case keyEq k k2 of
    Nothing -> go rest
    Just Refl -> Just v