first commit (finished up to chapter 19)

Author: nettok

.gitignore

@@ -0,0 +1,22 @@
+# Created by https://www.gitignore.io/api/haskell
+
+### 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

README.md

@@ -0,0 +1 @@
+# haskellbook-exercises

addition/Addition.hs

@@ -0,0 +1,35 @@
+module Addition where
+
+import Test.Hspec
+import Test.QuickCheck
+
+
+main :: IO ()
+main = hspec $ do
+  describe "Addition" $ do
+    it "1 + 1 is greated than 1" $
+      ((1::Integer) + 1) > 1 `shouldBe` True
+    it "2 + 2 is equal to 4" $
+      (2::Integer) + 2 `shouldBe` 4
+    it "x + 1 is always greater than x" $
+      property $ \x -> x + 1 > (x::Integer)
+  describe "Multiplication" $ do
+    it "3 `mult` 5 is 15" $
+      mult (3::Integer) 5 `shouldBe` 15
+    it "3 `mult` 0 is 0" $
+      mult (3::Integer) 0 `shouldBe` 0
+    it "0 `mult` 5 is 15" $
+      mult (0::Integer) 5 `shouldBe` 0
+
+
+mult :: (Eq a, Num a) => a -> a -> a
+mult 0 _ = 0
+mult _ 0 = 0
+mult x y = x + mult x (y - 1)
+
+
+genTuple :: (Arbitrary a, Arbitrary b) => Gen (a, b)
+genTuple = do
+  a <- arbitrary
+  b <- arbitrary
+  return (a, b)

addition/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2016
+
+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 Author name here 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.

addition/addition.cabal

@@ -0,0 +1,22 @@
+name:                addition
+version:             0.1.0.0
+synopsis:            Simple project template from stack
+description:         Please see README.md
+homepage:            https://github.com/githubuser/addition#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          example@example.com
+copyright:           2016 Author name here
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:    Addition
+  ghc-options:        -Wall -fwarn-tabs
+  build-depends:      base >= 4.7 && < 5
+                    , hspec
+                    , QuickCheck
+  hs-source-dirs:     .
+  default-language:   Haskell2010

addition/stack.yaml

@@ -0,0 +1,20 @@
+flags: {}
+extra-package-dbs: []
+packages:
+- '.'
+extra-deps:
+- HUnit-1.3.1.1
+- QuickCheck-2.8.2
+- ansi-terminal-0.6.2.3
+- async-2.1.0
+- hspec-2.2.3
+- hspec-core-2.2.3
+- hspec-discover-2.2.3
+- hspec-expectations-0.7.2
+- primitive-0.6.1.0
+- quickcheck-io-0.1.2
+- random-1.1
+- setenv-0.1.1.3
+- stm-2.4.4.1
+- tf-random-0.5
+resolver: ghc-8.0.1

ch10database.hs

@@ -0,0 +1,53 @@
+module Chapter10Database where
+
+import Data.Time
+
+
+data DatabaseItem = DbString String
+                  | DbNumber Integer
+                  | DbDate UTCTime
+                  deriving (Eq, Ord, Show)
+
+theDatabase :: [DatabaseItem]
+theDatabase =
+  [
+    DbDate (UTCTime (fromGregorian 1911 5 1) (secondsToDiffTime 34123))
+  , DbNumber 9001
+  , DbString "Hola Mundo!"
+  , DbDate (UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123))
+  ]
+
+filterDbDate :: [DatabaseItem] -> [UTCTime]
+filterDbDate = foldr extractUtcTime []
+  where extractUtcTime (DbDate utcTime) acc = utcTime : acc
+        extractUtcTime _                acc = acc
+
+filterDbNumber :: [DatabaseItem] -> [Integer]
+filterDbNumber = foldr extractInteger []
+  where extractInteger (DbNumber int) acc = int : acc
+        extractInteger _              acc = acc
+
+mostRecent :: [DatabaseItem] -> UTCTime
+mostRecent = maximum . filterDbDate
+
+sumDb :: [DatabaseItem] -> Integer
+sumDb = sum . filterDbNumber
+
+avgDb :: [DatabaseItem] -> Double
+avgDb xs = (fromIntegral . sum) numbers / (fromIntegral . length) numbers
+  where numbers = filterDbNumber xs
+
+----
+
+stops  = "pbtdkg"
+vowels = "aeiou"
+
+asd :: [(Char, Char, Char)]
+asd = filter (\x -> getSt1 x == 'p') [(st1, v, st2) | st1 <- stops, v <- vowels, st2 <- stops]
+  where getSt1 (st1, _, _) = st1
+
+myAny :: (a -> Bool) -> [a] -> Bool
+myAny p = foldr (\x acc -> acc || p x) False
+
+myMap :: (a -> b) -> [a] -> [b]
+myMap f = foldr (\x acc -> f x : acc) []

ch11btree.hs

@@ -0,0 +1,26 @@
+module Chapter11BTree where
+
+
+data BinaryTree a =
+    Leaf
+  | Node (BinaryTree a) a (BinaryTree a)
+  deriving (Eq, Ord, Show)
+
+insertBT :: Ord a => a -> BinaryTree a -> BinaryTree a
+insertBT e Leaf = Node Leaf e Leaf
+insertBT e (Node l x r)
+  | e > x     = Node l x (insertBT e r)
+  | e < x     = Node (insertBT e l) x r
+  | otherwise = Node l x r
+
+mapBT :: (a -> b) -> BinaryTree a -> BinaryTree b
+mapBT _ Leaf         = Leaf
+mapBT f (Node l x r) = Node (mapBT f l) (f x) (mapBT f r)
+
+toListBT :: BinaryTree a -> [a]
+toListBT Leaf         = []
+toListBT (Node l x r) = x : toListBT l ++ toListBT r
+
+foldBT :: (a -> b -> b) -> b -> BinaryTree a -> b
+foldBT _ z Leaf         = z
+foldBT f z (Node l x r) = f x (foldBT f (foldBT f z r) l)

ch11cipher.hs

@@ -0,0 +1,22 @@
+module Chapter11Cipher where
+
+import Data.Char
+
+caesarChar :: Int -> Char -> Char
+caesarChar rShift char = chr $ ord char + rShift
+
+encrypt :: Int -> String -> String
+encrypt rShift = map (caesarChar rShift)
+
+decrypt :: Int -> String -> String
+decrypt rShift = map (caesarChar (-rShift))
+
+encrypt' :: String -> String -> String
+encrypt' password plainText = map g f
+  where f             = zip (cycle password) plainText
+        g (key, char) = caesarChar (ord key - ord 'A') char
+
+decrypt' :: String -> String -> String
+decrypt' password cypher = map g f
+  where f             = zip (cycle password) cypher
+        g (key, char) = caesarChar (negate $ ord key - ord 'A') char

ch11huttonrazor.hs

@@ -0,0 +1,16 @@
+module Chapter11HuttonRazor where
+
+data Expr =
+    Lit Integer
+  | Add Expr Expr
+  | Group Expr
+
+eval :: Expr -> Integer
+eval (Lit n)           = n
+eval (Add lexpr rexpr) = eval lexpr + eval rexpr
+eval (Group expr)      = eval expr
+
+printExpr :: Expr -> String
+printExpr (Lit n)           = show n
+printExpr (Add lexpr rexpr) = printExpr lexpr ++ " + " ++ printExpr rexpr
+printExpr (Group expr)      = "(" ++ printExpr expr ++ ")"

ch11jammin.hs

@@ -0,0 +1,33 @@
+module Chapter11Jammin where
+
+import Data.List
+
+data Fruit =
+    Peach
+  | Plum
+  | Apple
+  | Blackberry
+  | Banana
+  deriving (Eq, Show, Ord)
+
+data JamJars = Jam
+  {
+    fruit :: Fruit
+  , cannedCount :: Int
+  } deriving (Eq, Show, Ord)
+
+allJam :: [JamJars]
+allJam = [Jam Peach 3, Jam Apple 2, Jam Plum 0, Jam Blackberry 4, Jam Banana 5, Jam Plum 1, Jam Apple 6]
+
+countCannedJamJars :: [JamJars] -> Int
+countCannedJamJars = foldr (\jj acc -> cannedCount jj + acc) 0
+
+mostJam :: [JamJars] -> JamJars
+mostJam jjs = foldr maxJj (head jjs) jjs
+  where maxJj x y = if cannedCount x > cannedCount y then x else y
+
+compareJamFruit :: JamJars -> JamJars -> Ordering
+compareJamFruit jj1 jj2 = compare (fruit jj1) (fruit jj2)
+
+groupJam :: [JamJars] -> [[JamJars]]
+groupJam = groupBy (\jj1 jj2 -> fruit jj1 == fruit jj2) . sort

ch11phone.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Chapter11Phone where
+
+import qualified Data.Char as C
+import qualified Data.Text as T
+
+
+type NextInputCharIsUpper = Bool
+type OutputChoices = () -> [Char]
+
+data KeyBuffer = EmptyKeyBuffer | PressedKeyBuffer Char Int OutputChoices deriving (Show)
+
+data TextpadST = TextpadST T.Text KeyBuffer NextInputCharIsUpper deriving (Show)
+
+
+instance Show OutputChoices where
+  show f = show (take 5 (f ()) ++ "...")
+
+
+pressTextpadKey :: TextpadST -> Char -> TextpadST
+pressTextpadKey tp key =
+  case C.toUpper key of
+    '1' -> appendChar (acceptKeyBuffer tp) '1'
+    '2' -> pressKey tp '2' (\() -> cycle ['a'..'c'])
+    '3' -> pressKey tp '3' (\() -> cycle ['d'..'f'])
+    '4' -> pressKey tp '4' (\() -> cycle ['g'..'i'])
+    '5' -> pressKey tp '5' (\() -> cycle ['j'..'l'])
+    '6' -> pressKey tp '6' (\() -> cycle ['m'..'o'])
+    '7' -> pressKey tp '7' (\() -> cycle ['p'..'s'])
+    '8' -> pressKey tp '8' (\() -> cycle ['t'..'v'])
+    '9' -> pressKey tp '9' (\() -> cycle ['w'..'z'])
+    '*' -> toogleCase tp
+    '0' -> pressKey tp '0' (\() -> cycle ['+', ' '])
+    '#' -> pressKey tp '#' (\() -> cycle ['.', ','])
+    'P' -> acceptKeyBuffer tp
+    _   -> tp
+
+pressTextpadKeys :: String -> TextpadST
+pressTextpadKeys = foldl pressTextpadKey (TextpadST T.empty EmptyKeyBuffer False)
+
+pressKey :: TextpadST -> Char -> OutputChoices -> TextpadST
+pressKey (TextpadST txt EmptyKeyBuffer nextInputCharIsUpper) c oc = TextpadST txt (PressedKeyBuffer c 1 oc) nextInputCharIsUpper
+pressKey tp@(TextpadST txt (PressedKeyBuffer c' count oc') nextInputCharIsUpper) c oc =
+  if c == c'
+    then TextpadST txt (PressedKeyBuffer c' (count + 1) oc') nextInputCharIsUpper
+    else pressKey (acceptKeyBuffer tp) c oc
+
+toogleCase :: TextpadST -> TextpadST
+toogleCase (TextpadST txt keyBuffer nextInputCharIsUpper) = TextpadST txt keyBuffer (not nextInputCharIsUpper)
+
+acceptKeyBuffer :: TextpadST -> TextpadST
+acceptKeyBuffer (TextpadST txt EmptyKeyBuffer nextInputCharIsUpper) = TextpadST txt EmptyKeyBuffer nextInputCharIsUpper
+acceptKeyBuffer tp@(TextpadST _ (PressedKeyBuffer _ count oc') _) = appendChar tp (oc' () !! (count - 1))
+
+appendChar :: TextpadST -> Char -> TextpadST
+appendChar (TextpadST txt _ nextInputCharIsUpper) c = TextpadST (T.snoc txt (setCase c)) EmptyKeyBuffer False
+  where setCase = if nextInputCharIsUpper then C.toUpper else id

ch11prog.hs

@@ -0,0 +1,31 @@
+module Chapter11Programming where
+
+
+data OperatingSystem =
+    GnuPlusLinux
+  | OpenBSD
+  | Mac
+  | Windows
+  deriving (Eq, Show, Enum)
+
+data ProgrammingLanguage =
+    Haskell
+  | Agda
+  | Idris
+  | PureScript
+  deriving (Eq, Show, Enum)
+
+data Programmer =
+  Programmer {
+    os   :: OperatingSystem
+  , lang :: ProgrammingLanguage
+  } deriving (Eq, Show)
+
+allOperatingSystems :: [OperatingSystem]
+allOperatingSystems = enumFrom $ toEnum 0
+
+allLanguages :: [ProgrammingLanguage]
+allLanguages = enumFrom $ toEnum 0
+
+allProgrammers :: [Programmer]
+allProgrammers = [Programmer os' lang' | os' <- allOperatingSystems, lang' <- allLanguages]