maybe-haskell-homework-bad-functor

Lib.hs

module Lib
    ( someFunc
    , DeciderOutcome(..)
    , badFmap1
    , badFmap2
    , badFmap3
    ) where

data DeciderOutcome a
  = Outcome a
  -- ^ We got an outcome (e.g. dice roll of 2, coin flip of heads)
  | ErrorFlewOffTable
  -- ^ Our decider didn't properly land on the table
  | ErrorLandedOnItsEdge
  -- ^ Our decider defied physics and landed on its edge/corner/side
  deriving (Eq, Show)

instance Functor DeciderOutcome where
  fmap f (Outcome v) = Outcome $ f v
  fmap _ ErrorFlewOffTable = ErrorFlewOffTable
  fmap _ ErrorLandedOnItsEdge = ErrorLandedOnItsEdge

-- Flip flops the errors
-- 1 case
badFmap1 :: (a -> b) -> DeciderOutcome a -> DeciderOutcome b
badFmap1 f (Outcome v) = Outcome $ f v
badFmap1 _ ErrorFlewOffTable = ErrorLandedOnItsEdge
badFmap1 _ ErrorLandedOnItsEdge = ErrorFlewOffTable

-- Changes a success to errors (lossy success and/or errors)
-- 2 * 2 * 2 cases = 8 cases
badFmap2 :: (a -> b) -> DeciderOutcome a -> DeciderOutcome b
badFmap2 _ (Outcome _) = ErrorLandedOnItsEdge
badFmap2 _ ErrorFlewOffTable = ErrorLandedOnItsEdge
badFmap2 _ ErrorLandedOnItsEdge = ErrorFlewOffTable

-- Success but changes the error (lossy errors)
-- 2 cases
badFmap3 :: (a -> b) -> DeciderOutcome a -> DeciderOutcome b
badFmap3 f (Outcome v) = Outcome $ f v
badFmap3 _ ErrorFlewOffTable = ErrorFlewOffTable
badFmap3 _ ErrorLandedOnItsEdge = ErrorFlewOffTable

-- 11 bad cases. Also, using case analysis...
-- 3 possible definitions for 'Outcome v' case
-- 2 possible definitions for 'ErrorFlewOffTable' case
-- 2 possible definitions for 'ErrorLandedOnItsEdge' case
-- 1 lawful definition
--
-- so,  3*2*2-1 = 11

someFunc :: IO ()
someFunc = putStrLn "someFunc"

output.txt

Functor DeciderOutcome
  identity
    +++ OK, passed 100 tests.
  compositions
    +++ OK, passed 100 tests.
badFmap1
  identity FAILED [1]
  compositions FAILED [2]
badFmap2
  identity FAILED [3]
  compositions FAILED [4]
badFmap3
  identity FAILED [5]
  compositions
    +++ OK, passed 100 tests.

Failures:

  test/Spec.hs:28:5: 
  1) badFmap1 identity
       Falsified (after 2 tests):
         Die32 ErrorLandedOnItsEdge

  To rerun use: --match "/badFmap1/identity/"

  test/Spec.hs:31:5: 
  2) badFmap1 compositions
       Falsified (after 1 test and 6 shrinks):
         {_->0}
         {_->0}
         Die32 ErrorFlewOffTable

  To rerun use: --match "/badFmap1/compositions/"

  test/Spec.hs:35:5: 
  3) badFmap2 identity
       Falsified (after 1 test):
         Die32 (Outcome 21)

  To rerun use: --match "/badFmap2/identity/"

  test/Spec.hs:38:5: 
  4) badFmap2 compositions
       Falsified (after 1 test and 6 shrinks):
         {_->0}
         {_->0}
         Die32 ErrorFlewOffTable

  To rerun use: --match "/badFmap2/compositions/"

  test/Spec.hs:42:5: 
  5) badFmap3 identity
       Falsified (after 2 tests):
         Die32 ErrorLandedOnItsEdge

  To rerun use: --match "/badFmap3/identity/"

Randomized with seed 1516855505

Finished in 0.0042 seconds
8 examples, 5 failures

Spec.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Test.Hspec
import Test.QuickCheck
import Control.Exception (evaluate)
import Lib

newtype Die32 = Die32 (DeciderOutcome Int)
  deriving (Eq, Show)

instance Arbitrary Die32 where
  arbitrary =
    Die32 <$> oneof [
      Outcome <$> choose (1, 32)
    , pure ErrorFlewOffTable
    , pure ErrorLandedOnItsEdge
    ]

main :: IO ()
main = hspec $ do
  describe "Functor DeciderOutcome" $ do
    it "identity" $ property $ \(Die32 die) ->
      fmap id die == id die

    it "compositions" $ property $ \(Fn (f :: Int -> Int)) (Fn (g :: Int -> Int)) (Die32 die) ->
      fmap (f . g) die ==  (fmap f . fmap g) die

  describe "badFmap1" $ do
    it "identity" $ property $ \(Die32 die) ->
      badFmap1 id die == id die

    it "compositions" $ property $ \(Fn (f :: Int -> Int)) (Fn (g :: Int -> Int)) (Die32 die) ->
      badFmap1 (f . g) die ==  (badFmap1 f . badFmap1 g) die

  describe "badFmap2" $ do
    it "identity" $ property $ \(Die32 die) ->
      badFmap2 id die == id die

    it "compositions" $ property $ \(Fn (f :: Int -> Int)) (Fn (g :: Int -> Int)) (Die32 die) ->
      badFmap2 (f . g) die ==  (badFmap2 f . badFmap2 g) die

  describe "badFmap3" $ do
    it "identity" $ property $ \(Die32 die) ->
      badFmap3 id die == id die

    it "compositions" $ property $ \(Fn (f :: Int -> Int)) (Fn (g :: Int -> Int)) (Die32 die) ->
      badFmap3 (f . g) die ==  (badFmap3 f . badFmap3 g) die