Refactored the Applicative chapter using stack

Author: BoeingX

.gitignore

@@ -0,0 +1,27 @@
+# Haskell
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+
+# Custom
+haskell-programming-from-first-principles.cabal
+*~

ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for haskell-programming-from-first-principles
+
+## Unreleased changes

LICENSE

@@ -0,0 +1,30 @@
+Copyright BoeingX (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of BoeingX nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,38 @@
+# Haskell Programming from First Principles
+
+**Disclaimer: this is an on-going project and is subject to frequent changes.**
+
+This repository hosts my notes and solutions to exercises in the book
+[Haskell Programming from First Principles](http://haskellbook.com/).
+
+## Dependencies
+
+The only dependency is [Stack](https://docs.haskellstack.org/en/stable/README/). 
+Once setup, Stack takes care of any Haskell package dependencies.
+
+## Project structure
+
+This repository is organized as a single Stack project.
+Exercise(s) solutions can be found at
+```bash
+src/<chapter name>/<section name>/<exercise name>.hs
+```
+Companion test suites (if available) can be found at
+```bash
+test/<chapter name>/<section name>/<exercise name>Spec.hs
+```
+
+## Run test
+
+All test suites can be discovered by `hspec-discover`. To run tests, simply do
+
+```bash
+stack test
+```
+or
+```bash
+stack --fast test
+```
+if you want avoid GHC optimization (hence faster).
+
+## Troubleshooting

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

package.yaml

@@ -0,0 +1,40 @@
+name:                haskell-programming-from-first-principles
+version:             0.1.0.0
+github:              "BoeingX/haskell-programming-from-first-principles"
+license:             BSD3
+author:              "BoeingX"
+maintainer:          "[email protected]"
+copyright:           "BSD3"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Education
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/BoeingX/haskell-programming-from-first-principles#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- hspec
+- QuickCheck
+- checkers
+
+library:
+  source-dirs: src
+
+tests:
+  haskell-programming-from-first-principles-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - haskell-programming-from-first-principles

src/Applicative/ApplicativeInUse/ConstantExercise.hs

@@ -0,0 +1,13 @@
+module Applicative.ApplicativeInUse.ConstantExercise (
+    Constant (..)
+) where
+
+newtype Constant a b = Constant { getConstant :: a } 
+                     deriving (Eq, Ord, Show)
+
+instance Functor (Constant a) where
+    fmap _ (Constant a) = Constant a
+
+instance Monoid a => Applicative (Constant a) where
+    pure _ = Constant mempty
+    Constant a <*> Constant b = Constant $ a <> b

src/Applicative/ApplicativeInUse/IdentityExercise.hs

@@ -0,0 +1,11 @@
+module Applicative.ApplicativeInUse.IdentityExercise (
+    Identity (..)
+) where
+
+newtype Identity a = Identity a
+    deriving (Eq, Ord, Show)
+instance Functor Identity where
+    fmap f (Identity a) = Identity $ f a
+instance Applicative Identity where
+    pure = Identity
+    Identity f <*> Identity a = Identity $ f a

src/Applicative/ApplicativeInUse/MaybeExercise.hs

@@ -0,0 +1,7 @@
+module Applicative.ApplicativeInUse.MaybeExercise () where
+
+maybe :: Maybe String
+maybe = const <$> Just "Hello" <*> pure "World"
+
+maybe' :: Maybe (Int, Int, String, [Int])
+maybe' = (,,,) <$> Just 90 <*> Just 10 <*> Just "Tierness" <*> pure [1, 2, 3]

src/Applicative/ApplicativeInUse/ShortExercises.hs

@@ -0,0 +1,43 @@
+module Applicative.ApplicativeInUse.ShortExercises () where
+
+import Data.List (elemIndex)
+
+-- Question 1
+added :: Maybe Integer
+added = fmap (+3) (lookup 3 $ zip [1, 2, 3] [4, 5, 6])
+
+-- Question 2
+y :: Maybe Integer
+y = lookup 3 $ zip [1, 2, 3] [4, 5, 6]
+
+z :: Maybe Integer
+z = lookup 2 $ zip [1, 2, 3] [4, 5, 6]
+
+tupled :: Maybe (Integer, Integer)
+tupled = (,) <$> y <*> z
+
+-- Question 3
+x :: Maybe Int
+x = elemIndex 3 [1, 2, 3, 4, 5]
+
+y' :: Maybe Int
+y' = elemIndex 4 [1, 2, 3, 4, 5]
+
+max' :: Int -> Int -> Int
+max' = max
+
+maxed :: Maybe Int
+maxed = max' <$> x <*> y'
+
+-- Question 4
+xs = [1, 2, 3]
+ys = [4, 5, 6]
+
+x' :: Maybe Integer
+x' = lookup 3 $ zip xs ys
+
+y'' :: Maybe Integer
+y'' = lookup 2 $ zip xs ys
+
+summed :: Maybe Integer
+summed = fmap sum $ (,) <$> x' <*> y''

src/Applicative/ApplicativeLaws/.gitkeep

@@ -0,0 +1,128 @@
+module Applicative.ChapterExercises.ApplicativeInstances (
+    Identity (..)
+  , Pair (..)
+  , Two (..)
+  , Three (..)
+  , Three' (..)
+  , Four (..)
+  , Four' (..)
+) where
+
+import Control.Applicative (liftA2, liftA3)
+import Test.QuickCheck
+import Test.QuickCheck.Checkers
+
+-- Question 1
+newtype Identity a = Identity a
+                   deriving (Show, Eq)
+
+instance Applicative Identity where
+    pure = Identity
+    Identity f <*> Identity x = Identity $ f x
+
+instance Functor Identity where
+    fmap f (Identity a) = Identity $ f a
+
+instance (Arbitrary a) => Arbitrary (Identity a) where
+    arbitrary = Identity <$> arbitrary
+
+instance (Eq a) => EqProp (Identity a) where (=-=) = eq
+
+-- Question 2
+data Pair a = Pair a a
+            deriving (Show, Eq)
+
+instance Functor Pair where
+    fmap f (Pair a b) = Pair (f a) (f b)
+
+instance Applicative Pair where
+    pure a = Pair a a
+    Pair f g <*> Pair x y = Pair (f x) (g y)
+
+instance (Arbitrary a) => Arbitrary (Pair a) where
+    arbitrary = liftA2 Pair arbitrary arbitrary
+
+instance (Eq a) => EqProp (Pair a) where (=-=) = eq
+
+-- Question 3
+data Two a b = Two a b
+             deriving (Show, Eq)
+
+instance Functor (Two a) where
+    fmap f (Two a b) = Two a (f b)
+
+instance (Monoid a) => Applicative (Two a) where
+    pure = Two mempty
+    Two f g <*> Two x y = Two (f <> x) (g y)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
+    arbitrary = liftA2 Two arbitrary arbitrary
+
+instance (Eq a, Eq b) => EqProp (Two a b) where (=-=) = eq
+
+-- Question 4
+data Three a b c = Three a b c
+                 deriving (Show, Eq)
+
+instance Functor (Three a b) where
+    fmap f (Three a b c) = Three a b (f c)
+
+instance (Monoid a, Monoid b) => Applicative (Three a b) where
+    pure = Three mempty mempty
+    Three f g h <*> Three x y z = Three (f <> x) (g <> y) (h z)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (Three a b c) where
+    arbitrary = liftA3 Three arbitrary arbitrary arbitrary
+
+instance (Eq a, Eq b, Eq c) => EqProp (Three a b c) where (=-=) = eq
+
+
+-- Question 5
+data Three' a b = Three' a b b
+                deriving (Show, Eq)
+
+instance Functor (Three' a) where
+    fmap f (Three' a b b') = Three' a (f b) (f b')
+
+instance (Monoid a) => Applicative (Three' a) where
+    pure b = Three' mempty b b
+    Three' f g h <*> Three' x y z = Three' (f <> x) (g y) (h z)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Three' a b) where
+    arbitrary = liftA3 Three' arbitrary arbitrary arbitrary
+
+instance (Eq a, Eq b) => EqProp (Three' a b) where (=-=) = eq
+
+
+-- Question 6
+data Four a b c d = Four a b c d
+                  deriving (Show, Eq)
+
+instance Functor (Four a b c) where
+    fmap f (Four a b c d) = Four a b c (f d)
+
+instance (Monoid a, Monoid b, Monoid c) => Applicative (Four a b c) where
+    pure = Four mempty mempty mempty
+    Four f g h i <*> Four x y z w = Four (f <> x) (g <> y) (h <> z) (i w)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (Four a b c d) where
+    arbitrary = Four <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+instance (Eq a, Eq b, Eq c, Eq d) => EqProp (Four a b c d) where (=-=) = eq
+
+
+-- Question 7
+data Four' a b = Four' a a a b
+               deriving (Show, Eq)
+
+instance Functor (Four' a) where
+    fmap f (Four' a a' a'' b) = Four' a a' a'' (f b)
+
+instance (Monoid a) => Applicative (Four' a) where
+    pure = Four' mempty mempty mempty
+    Four' f g h i <*> Four' x y z w = Four' (f <> x) (g <> y) (h <> z) (i w)
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Four' a b) where
+    arbitrary = Four' <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+instance (Eq a, Eq b) => EqProp (Four' a b) where (=-=) = eq

src/Applicative/ChapterExercises/ApplicativeInstances.hs

@@ -0,0 +1,14 @@
+module Applicative.ChapterExercises.Combinations (
+    stops
+  , vowels
+  , combos
+) where
+
+import Control.Applicative (liftA3)
+
+stops, vowels :: String
+stops = "pbtdkg"
+vowels = "aeiou"
+
+combos :: [a] -> [b] -> [c] -> [(a, b, c)]
+combos = liftA3 (,,)

src/Applicative/ChapterExercises/Combinations.hs

@@ -0,0 +1,25 @@
+Given a type that has an instance of Applicative, specialize the types of the methods.
+
+1. `[]`
+```haskell
+pure :: a -> [a]
+(<*>) :: [(a -> b)] -> [a] -> [b]
+```
+
+2. `IO`
+```haskell
+pure :: a -> IO a
+(<*>) :: IO (a -> b) -> IO a -> IO b
+```
+
+3. `(,) a`
+```haskell
+pure :: a -> (t, a)
+(<*>) :: (t, (a -> b)) -> (t, a) -> (t, b)
+```
+
+4. `(->) e`
+```haskell
+pure :: a -> (e -> a)
+(<*>) :: (e -> (a -> b)) -> (e -> a) -> (e -> b)
+```