Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,259
    • Issues 5,259
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 563
    • Merge requests 563
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #1776
Closed
Open
Issue created Oct 15, 2007 by guest@trac-guest

type families : couldn't match type "Elem a" against type "Elem a"

I received the error

GHCi, version 6.8.0.20071012: http://www.haskell.org/ghc/  :? for help
Loading package base ... linking ... done.
[1 of 1] Compiling Test             ( Test.hs, interpreted )

Test.hs:17:27:
    Couldn't match expected type `Elem a'
           against inferred type `Elem a'
      Expected type: Elem a -> Maybe (Elem a) -> Maybe (Elem a)
      Inferred type: Elem a -> Maybe (Elem a) -> Maybe (Elem a)
    In the first argument of `foldr', namely `mf'
    In the second argument of `fromMaybe', namely
        `(foldr mf Nothing xs)'
Failed, modules loaded: none.

when running the following module in GHCi:

{-# LANGUAGE TypeFamilies #-}

module Test where

import qualified Prelude as P
import Prelude hiding (foldr, foldr1)

import Data.Maybe

type family Elem a

class Foldable a where
    foldr :: (Elem a -> b -> b) -> b -> a -> b

    foldr1 :: (Elem a -> Elem a -> Elem a) -> a -> Elem a
    foldr1 f xs = fromMaybe (error "foldr1: empty structure")
                    (foldr mf Nothing xs)
       where mf x Nothing  = Just x
             mf x (Just y) = Just (f x y)
Trac metadata
Trac field Value
Version 6.8
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC aslatter@gmail.com
Operating system Unknown
Architecture Unknown
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking