Inspired by http://www.csis.pace.edu/~bergin/patterns/ppoop.html and by Rob Pike's response: https://plus.google.com/+RobPikeTheHuman/posts/hoJdanihKwb

PrintOS.hs

-- Inspired by http://www.csis.pace.edu/~bergin/patterns/ppoop.html
-- and by Rob Pike's response: https://plus.google.com/+RobPikeTheHuman/posts/hoJdanihKwb

import System.Info (os)
import Data.Map (Map, findWithDefault, fromList)

class AbstractOsObject a where
  getOsString :: a -> String
  coerce :: a -> BaseOsObject

data BaseOsObject
  = BaseOsObject
  { getString :: String
  }
instance AbstractOsObject BaseOsObject where
  getOsString = getString
  coerce = id

data ExtendedOsObject
  = ExtendedOsObject
  { getExtendedOsString :: String
  , someExtraStuff :: ()
  }
instance AbstractOsObject ExtendedOsObject where
  getOsString = getExtendedOsString
  coerce = BaseOsObject . getExtendedOsString

unixBox :: BaseOsObject
unixBox = BaseOsObject "This is a UNIX box and therefore good."

windowsBox :: BaseOsObject
windowsBox = BaseOsObject "This is a Windows box and therefore bad."

defaultBox :: BaseOsObject
defaultBox = BaseOsObject "This is a default box."

appleBox :: ExtendedOsObject
appleBox = ExtendedOsObject "This is an Apple box and therefore superior." ()

dispatch :: Map String BaseOsObject
dispatch = fromList $
  [ ("SunOs", coerce unixBox)
  , ("Linux", coerce unixBox)
  , ("linux", coerce unixBox)
  , ("Windows NT", coerce windowsBox)
  , ("Windows 95", coerce windowsBox)
  , ("Mac OS", coerce appleBox)
  , ("darwin", coerce appleBox)
  , ("mingw32", coerce windowsBox)
  , ("ios", coerce appleBox)
  ]

main :: IO ()
main = print $ getOsString osObj
  where
    osObj = findWithDefault defaultBox os dispatch