update the code examples

src/AlgebraicDataTypes.hs

@@ -22,20 +22,22 @@ data Pair = P Status Severity --deriving (Show)
 
 data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Eq, Show, Read, Functor, Foldable)
 
---data  Maybe a  =  Nothing | Just a deriving (Eq, Ord)
-{--
-lookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b
-lookup _key []          =  Nothing
-lookup  key ((x,y):xys)
+-- data  Maybe a  =  Nothing | Just a deriving (Eq, Ord)
+{--}
+lookup'                 :: String -> [(String,Double)] -> Maybe Double
+lookup' _key []         =  Nothing
+lookup'  key ((x,y):xys)
     | key == x          =  Just y
-    | otherwise         =  lookup key xys
+    | otherwise         =  lookup' key xys
 --}
 
-safeDiv :: (Eq a, Fractional a) => a -> a -> Maybe a
+--safeDiv :: (Eq a, Fractional a) => a -> a -> Maybe a
+safeDiv :: Double -> Double -> Maybe Double
 safeDiv _ 0 = Nothing
 safeDiv x y = Just (x / y)
 
-safeRoot :: (Ord a, Floating a) => a -> Maybe a
+--safeRoot :: (Ord a, Floating a) => a -> Maybe a
+safeRoot :: Double -> Maybe Double
 safeRoot x
   | x < 0     = Nothing
   | otherwise = Just (sqrt x)
@@ -54,15 +56,16 @@ andThen :: Maybe a -> (a -> Maybe b) -> Maybe b
 andThen Nothing _fun = Nothing
 andThen (Just x) fun = fun x
 
+findDivRoot'''' :: Eq a => Double -> a -> [(a, Double)] -> Maybe Double
 findDivRoot'''' x key map =
   lookup key map `andThen` \y ->
   safeDiv x y    `andThen` \d ->
   safeRoot d
 
 findDivRoot' x key map =
-  lookup key map >>= \y ->
-  safeDiv x y    >>= \d ->
-  safeRoot d
+  lookup key map >>= -- \y ->
+  safeDiv x    >>= -- \d ->
+  safeRoot
 
 findDivRoot'' x key map = 
   lookup key map >>=

src/Functions.hs

@@ -1,7 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
 module Functions where
 
 import Control.Arrow ((>>>))
-import Data.Natural
+import Data.Natural ( Natural )
 import Prelude hiding ((.))
 
 -- define constant `aNumber` with a value of 42.
@@ -16,13 +17,17 @@ aString = "Hello World"
 square :: Integer -> Integer
 square n = n ^ 2
 
+-- define a function `double` which takes an Integer as argument and compute its double
 double :: Integer -> Integer
 double n = 2 * n
 
--- combining functions with the `.` operator: (.) :: (b -> c) -> (a -> b) -> a -> c
+(∘) :: (b -> c) -> (a -> b) -> a -> c -- f :: a -> b, g :: b -> c
+(g ∘ f) x = g (f x)
+
+-- combining functions with the `.` operator: (∘) :: (b -> c) -> (a -> b) -> a -> c
 squareAfterDouble :: Integer -> Integer
---squareAfterDouble = square . double
-squareAfterDouble n = (square . double) n
+squareAfterDouble = square ∘ double
+--squareAfterDouble n = (square ∘ double) n
 
 ifOddDouble :: Integer -> Integer
 ifOddDouble n =
@@ -48,7 +53,10 @@ ifOddDouble' n = ifOdd double n
 ifOddSquare' :: Integer -> Integer
 ifOddSquare' n = ifOdd square n
 
-ifPredGrow :: (Integer -> Bool) -> (Integer -> Integer) -> Integer -> Integer
+ifPredGrow :: (Integer -> Bool)     -- a predicate function argument
+           -> (Integer -> Integer)  -- a growth function argument
+           -> Integer               -- the input number
+           -> Integer               -- the output number
 ifPredGrow predicate growthFunction n =
   if predicate n
     then growthFunction n
@@ -79,21 +87,28 @@ add x y = x + y
 add5 :: Integer -> Integer
 add5 = add 5
 
-(.) :: (b -> c) -> (a -> b) -> a -> c
-(.) f g x = f (g x)
 
 -- combining functions with the `.` operator: (.) :: (b -> c) -> (a -> b) -> a -> c
 add5AndSquare :: Integer -> Integer
-add5AndSquare = square . add5
+add5AndSquare = square ∘ add5
 
 -- or by using the (>>>) operator: f >>> g = g . f
--- add5AndSquare = add5 >>> square
+add5AndSquare' :: Integer -> Integer
+add5AndSquare' = add5 >>> square
 
 -- The function curry takes a function of type ((a, b) -> c) and return the equivalent curried function of type a -> b -> c
 -- curry :: ((a, b) -> c) -> a -> b -> c
 curMul :: Integer -> Integer -> Integer
 curMul = curry mul
 
+{--
+curry                   :: ((a, b) -> c) -> a -> b -> c
+curry f x y             =  f (x, y)
+
+uncurry                 :: (a -> b -> c) -> ((a, b) -> c)
+uncurry f p             =  f (fst p) (snd p)
+--}
+
 -- uncurry does the inverse, take the curried form and return the equivalent uncurried function
 -- uncurry :: (a -> b -> c) -> (a, b) -> c
 uncurAdd :: (Integer, Integer) -> Integer
@@ -108,6 +123,36 @@ factorial n =
 
 -- definition of factorial using pattern matching
 fac :: Natural -> Natural
-fac 0 = 1
-fac n = n * fac (n - 1)
+fac 0 = 1                 -- (a)
+fac n = n * fac (n - 1)   -- (b)
 
+{--
+fac 2 = 2 * fac (2 - 1)       -- (b)
+      = 2 * fac 1             -- 2 - 1
+      = 2 * 1 * fac (1 - 1)   -- (b)
+      = 2 * fac 0)            -- 1-1=0 , 2*1=2
+      = 2 * 1                 -- (1)
+      = 2                     -- 2*1=2
+--}
+{--
+even :: Integer -> Bool
+even n =  n `rem` 2 == 0
+
+odd :: Integer -> Bool
+odd n =  n `rem` 2 /= 0
+--}
+
+next :: Double -> Double -> Double
+next a x_n = (x_n + a/x_n)/2
+
+within :: Double -> [Double] -> Double
+within eps (a:b:rest) = 
+  if abs(a - b) <= eps 
+    then b
+    else within eps (b:rest)
+
+root :: Double -> Double -> Double
+root a eps = within eps (repeat' (next a) (a/2))
+
+repeat' :: (a -> a) -> a -> [a]
+repeat' f a = a : (repeat' f (f a))

src/LazyEvaluation.hs

@@ -1,12 +1,13 @@
 module LazyEvaluation where
 
-import Data.Natural
+import Data.Natural ( Natural )
 
 -- it's possible to define non-terminating expressions like
 viciousCircle :: a
 viciousCircle = viciousCircle
 
 -- this expression returns True because of lazy evaluation:
+test :: Bool
 test = (4 == 4) || viciousCircle
 
 ignoreY :: Integer -> Integer -> Integer
@@ -14,12 +15,15 @@ ignoreY x y = x
 
 -- arithmetic sequences
 -- all natural numbers
+naturalNumbers :: [Integer]
 naturalNumbers = [0..]
 
 -- all even numbers
+evens :: [Integer]
 evens = [2,4..]
 
 -- all odd numbers
+odds :: [Integer]
 odds  = [1,3..]
 
 fibs :: [Integer]
@@ -53,16 +57,16 @@ myIf :: Bool -> b -> b -> b
 myIf p x y = if p then x else y    
 
 cond :: [(Bool, a)] -> a
-cond []                 = error "make sure that at least one condition is true"
-cond ((True,  v):rest)  = v
-cond ((False, _):rest)  = cond rest
+cond []                  = error "make sure that at least one condition is true"
+cond ((True,  v):_rest)  = v
+cond ((False, _):rest)   = cond rest
 
 sign :: (Ord a, Num a) => a -> a
 sign x = cond [(x > 0     , 1 )
               ,(x < 0     , -1)
               ,(otherwise , 0 )]
               
--- |An operator that allows you to write C-style ternary conditionals of
+-- | An operator that allows you to write C-style ternary conditionals of
 -- the form:
 -- > p ? t ?? f
 infixr  0 ?

src/Lists.hs

@@ -1,9 +1,11 @@
 module Lists where
 
-import Prelude hiding (map, foldr, length, filter)
-import qualified Prelude as P (foldr)
+import Prelude hiding (map, foldr, length, filter, sum)
+--import qualified Prelude as P (foldr)
 import Functions (square, double)
 
+--data [a] = [] | a : [a]
+
 -- a list of numbers to play around with
 someNumbers :: [Integer]
 someNumbers = [49,64,97,54,19,90,934,22,215,6,68,325,720,8082,1,33,31]
@@ -15,11 +17,12 @@ upToHundred = [1..100]
 oddsUpToHundred :: [Integer]
 oddsUpToHundred = [1,3..100]
 
+fac' :: Integer -> Integer
 fac' n   = prod [1..n]
 
 length :: [a] -> Integer
 length []     =  0
-length (x:xs) =  1 + length xs
+length (_x:xs) =  1 + length xs
 
 filter :: (a -> Bool) -> [a] -> [a]
 filter _pred []    = []
@@ -55,9 +58,9 @@ squareAll' :: [Integer] -> [Integer]
 squareAll' = map square
 
 
-sumUp :: [Integer] -> Integer
-sumUp [] = 0
-sumUp (n:rest) = n + sumUp rest
+sum :: [Integer] -> Integer
+sum [] = 0
+sum (n:rest) = n + sum rest
 
 prod :: [Integer] -> Integer
 prod [] = 1
@@ -81,6 +84,13 @@ prod' = foldr (*) 1
 -- making use of such abstract higher order functions
 -- algorithms can be defined in a dense declarative way
 
+len :: [a] -> Integer
+len = foldr count 0
+  where count _ n = n + 1
+
+map' :: (a1 -> a2) -> [a1] -> [a2]
+map' f = foldr ((:) . f) []
+
 -- now we have map and a reduce, what about the legendary map/reduce?
 -- it's called foldMap in Haskell
 
@@ -92,3 +102,55 @@ foldMap :: (Monoid m) => (a -> m) -> [a] -> m
 foldMap f = foldr (mappend . f) mempty
 
 
+
+
+
+-- building stuff based on lists
+
+newtype Stack a = Stck [a] deriving Show
+
+sempty :: Stack a
+sempty = Stck []
+
+pop :: Stack a -> (a, Stack a)
+pop (Stck [])     = error "Stack is empty!"
+pop (Stck (x:xs)) = (x, Stck xs)
+
+push :: Stack a -> a -> Stack a
+push (Stck l) x = Stck (x : l)
+
+rev :: Stack a -> Stack a
+rev (Stck xs) = Stck (reverse xs)
+
+
+type Queue a = (Stack a, Stack a)
+
+qempty :: Queue a
+qempty = (sempty, sempty)
+
+enqueue :: Queue a -> a -> Queue a
+enqueue (inStack, outStack) x = (push inStack x, outStack)
+
+dequeue :: Queue a -> (a, Queue a)
+dequeue (Stck [], Stck []) = error "Queue is empty!"
+dequeue (inStack, Stck []) = 
+  let revertedInStack = rev inStack
+      (x, restInstack) = pop revertedInStack
+  in (x, (Stck [], restInstack))
+dequeue (inStack, outStack) = 
+  let (x, restOutStack) = pop outStack
+  in (x, (inStack, restOutStack))
+
+type Queue' a = [a]
+
+qempty' :: Queue' a
+qempty' = []
+
+enqueue' :: Queue' a -> a -> Queue' a
+enqueue' q x = x:q
+
+dequeue' :: Queue' a -> (a, Queue' a)
+dequeue' [] = error "Queue is empty!"
+dequeue' xs = (last xs, init xs)
+
+

src/TypeClasses.hs

@@ -1,7 +1,6 @@
 module TypeClasses where
 
 import AlgebraicDataTypes (Status (..), Severity (..), PairStatusSeverity (..), Tree (..))
-import Data.Foldable
 import Data.Char (toUpper)
 
 instance Num Char where

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-15.2
+resolver: ghc-8.10.1 #lts-15.2
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.