Complete Functor

fp-course-haskell.cabal

@@ -21,6 +21,7 @@ library
   exposed-modules:
       Core
       ExactlyOne
+      Functor
       List
       Optional
       Validation
@@ -41,6 +42,7 @@ test-suite fp-course-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      FunctorSpec
       ListSpec
       OptionalSpec
       Property

src/Functor.hs

@@ -0,0 +1,131 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Functor where
+
+import Core
+import ExactlyOne
+import List
+import Optional
+import qualified Prelude as P (fmap)
+
+-- | All instances of the `Functor` type-class must satisfy two laws. These laws
+-- are not checked by the compiler. These laws are given as:
+--
+-- * The law of identity
+--   `∀x. (id <$> x) ≅ x`
+--
+-- * The law of composition
+--   `∀f g x.(f . g <$> x) ≅ (f <$> (g <$> x))`
+class Functor k where
+  -- Pronounced, eff-map.
+  (<$>) :: (a -> b) -> k a -> k b
+
+infixl 4 <$>
+
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> import Course.Core
+-- >>> import qualified Prelude as P(return, (>>))
+
+-- | Maps a function on the ExactlyOne functor.
+--
+-- >>> (+1) <$> ExactlyOne 2
+-- ExactlyOne 3
+instance Functor ExactlyOne where
+  (<$>) :: (a -> b) -> ExactlyOne a -> ExactlyOne b
+  (<$>) = mapExactlyOne
+
+-- | Maps a function on the List functor.
+--
+-- >>> (+1) <$> Nil
+-- []
+--
+-- >>> (+1) <$> (1 :. 2 :. 3 :. Nil)
+-- [2,3,4]
+instance Functor List where
+  (<$>) :: (a -> b) -> List a -> List b
+  (<$>) = map
+
+-- | Maps a function on the Optional functor.
+--
+-- >>> (+1) <$> Empty
+-- Empty
+--
+-- >>> (+1) <$> Full 2
+-- Full 3
+instance Functor Optional where
+  (<$>) :: (a -> b) -> Optional a -> Optional b
+  (<$>) = mapOptional
+
+-- | Maps a function on the reader ((->) t) functor.
+--
+-- >>> ((+1) <$> (*2)) 8
+-- 17
+instance Functor ((->) t) where
+  -- (->) t a is an alias for t -> a
+  -- Feed a into f
+  (<$>) :: (a -> b) -> (->) t a -> (->) t b
+  (<$>) = (.)
+
+-- | Anonymous map. Maps a constant value on a functor.
+--
+-- >>> 7 <$ (1 :. 2 :. 3 :. Nil)
+-- [7,7,7]
+--
+-- prop> \x a b c -> x <$ (a :. b :. c :. Nil) == (x :. x :. x :. Nil)
+--
+-- prop> \x q -> x <$ Full q == Full x
+(<$) :: (Functor k) => a -> k b -> k a
+(<$) = (<$>) . const
+
+-- | Apply a value to a functor-of-functions.
+--
+-- __NOTE__: The second argument is a bare @a@, not a @k a@. You need
+-- a more powerful typeclass, 'Applicative', if you want both the
+-- functions and the argmuents to be "inside" the Functor:
+--
+-- @
+-- (<*>) :: Applicative k => k (a -> b) -> k a -> k b
+-- @
+--
+-- We will talk about 'Applicative' soon.
+--
+-- >>> (*2) :. (+1) :. const 99 :. Nil ?? 8
+-- [16,9,99]
+--
+-- >>> Empty ?? 2
+-- Empty
+(??) :: (Functor k) => k (a -> b) -> a -> k b
+-- ($) :: (a -> b) -> a -> b
+(??) ff a = flip ($) a <$> ff
+
+infixl 1 ??
+
+-- | Anonymous map producing unit value.
+--
+-- >>> void (1 :. 2 :. 3 :. Nil)
+-- [(),(),()]
+--
+-- >>> void (Full 7)
+-- Full ()
+--
+-- >>> void Empty
+-- Empty
+--
+-- >>> void (+10) 5
+-- ()
+void :: (Functor k) => k a -> k ()
+void = (<$>) (const ())
+
+-----------------------
+-- SUPPORT LIBRARIES --
+-----------------------
+
+-- | Maps a function on an IO program.
+--
+-- >>> reverse <$> (putStr "hi" P.>> P.return ("abc" :: List Char))
+-- hi"cba"
+instance Functor IO where
+  (<$>) = P.fmap

test/FunctorSpec.hs

@@ -0,0 +1,56 @@
+module FunctorSpec (spec) where
+
+import ExactlyOne
+import qualified Functor as F
+import List (List (..))
+import Optional (Optional (..))
+import Test.Hspec
+import Test.Hspec.QuickCheck
+
+spec :: Spec
+spec = do
+  describe "ExactlyOne" $ do
+    it "increment" $
+      (+ 1) F.<$> ExactlyOne 2 `shouldBe` ExactlyOne (3 :: Int)
+
+  describe "List" $ do
+    it "empty list" $
+      (+ 1) F.<$> Nil `shouldBe` (Nil :: List Int)
+    it "increment" $
+      (+ 1) F.<$> (1 :. 2 :. 3 :. Nil) `shouldBe` ((2 :: Int) :. 3 :. 4 :. Nil)
+
+  describe "Optional" $ do
+    it "Empty" $
+      (+ 1) F.<$> Empty `shouldBe` (Empty :: Optional Int)
+    it "Full" $
+      (+ 1) F.<$> Full (2 :: Int) `shouldBe` Full 3
+
+  describe "Function" $ do
+    it "(->)" $
+      ((+ 1) F.<$> (* 2)) 8 `shouldBe` (17 :: Int)
+
+  describe "(<$)" $ do
+    it "Map 7" $
+      7 <$ ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` ((7 :: Int) :. 7 :. 7 :. Nil)
+    prop "Always maps a constant value over List" $
+      \x a b c -> (x :: Integer) <$ ((a :. b :. c :. Nil) :: List Integer) `shouldBe` (x :. x :. x :. Nil)
+    prop "Always maps a constant value over Full (Optional)" $
+      \x q -> x F.<$ Full (q :: Integer) `shouldBe` Full (x :: Integer)
+
+  describe "??" $ do
+    it "Map with List" $
+      (((* 2) :. (+ 1) :. const 99 :. Nil) F.?? 8) `shouldBe` ((16 :: Int) :. 9 :. 99 :. Nil)
+    it "Map with Optional" $
+      (Full (+ 1) F.?? 8) `shouldBe` Full (9 :: Int)
+    it "Map with Optional Empty" $
+      ((Empty :: Optional (Int -> Int)) F.?? 8) `shouldBe` Empty
+
+  describe "void" $ do
+    it "List" $
+      F.void ((1 :: Int) :. 2 :. 3 :. Nil) `shouldBe` () :. () :. () :. Nil
+    it "Full" $
+      F.void (Full (7 :: Int)) `shouldBe` Full ()
+    it "Empty" $
+      F.void Empty `shouldBe` Empty
+    it "(->)" $
+      F.void (+ (10 :: Int)) 5 `shouldBe` ()