{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
             FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

-- Example of improvement, due to George Russel

module Folders where

data Folder = Folder

newtype SB x = SB x
newtype SS x = SS x

data NodeArcsHidden = NodeArcsHidden

class HasSS hasS x | hasS -> x where
   toSS :: hasS -> SS x

instance HasSS (SB x) x where
   toSS (SB x) = (SS x)

class HMV option graph node where
   modd :: option -> graph -> node value -> IO ()

instance HMV NodeArcsHidden graph node
      => HMV (Maybe NodeArcsHidden) graph node
  where
   modd = error "burk"

gn :: HMV NodeArcsHidden graph node
   => graph
   -> SS (graph -> node Int -> IO ())
gn graph = fmapSS (\ arcsHidden -> (\ graph node -> modd arcsHidden graph node))
                  (toSS (error "C" :: SB (Maybe NodeArcsHidden)))

-- The call to modd gives rise to
--      HMV option graph node
-- The call to toSS gives rise to
--      HasSS (SB (Maybe NodeArcsHidden)) x
-- where (toSS (error ...)) :: SS x
-- and hence arcsHidden :: x
--
-- Then improvement should give x = Maybe NodeArcsHidden
-- and hence option=Maybe NodeArcsHidden

fmapSS :: (a->b) -> SS a -> SS b
fmapSS = error "urk"
