Merge pull request #1 from complexityclass/feature/chapter2

Feature/chapter2

.vscode/tasks.json

@@ -0,0 +1,19 @@
+{
+    // See https://go.microsoft.com/fwlink/?LinkId=733558
+    // for the documentation about the tasks.json format
+    "version": "2.0.0",
+    "tasks": [
+        {
+            "label": "Project build",
+            "type": "shell",
+            "command": "stack build; stack exec future-store-exe",
+            "problemMatcher": []
+        },
+        {
+            "label": "Run unit tests",
+            "type": "shell",
+            "command": "stack test :unit-tests",
+            "problemMatcher": []
+        }
+    ]
+}

future-store.cabal

@@ -30,6 +30,8 @@ library
   build-depends:
       base >= 4.7 && < 5
   exposed-modules:
+      Chapter2.DataTypes
+      Chapter2.SimpleFunctions
       Lib
   default-language: Haskell2010
 
@@ -53,3 +55,19 @@ test-suite future-store-test
       base >= 4.7 && < 5
     , future-store
   default-language: Haskell2010
+
+test-suite unit-tests
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  hs-source-dirs:
+      test/unit
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >= 4.7 && < 5
+    , future-store
+    , hspec
+    , hspec-discover
+  other-modules:
+      Chapter2.DataTypesSpec
+      Chapter2.SimpleFunctionsSpec
+  default-language: Haskell2010

package.yaml

@@ -46,3 +46,18 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - future-store
+
+  unit-tests:
+    main:                Spec.hs
+    source-dirs:         test/unit
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - future-store
+    - hspec
+    - hspec-discover
+
+
+

src/Chapter2/DataTypes.hs

@@ -0,0 +1,159 @@
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Chapter2.DataTypes (
+    Client (..),
+    Person (..),
+    Gender (..),
+    GenderStatInfo (..),
+    TimeMachine (..),
+    Producer (..),
+    TimeMachineInfo (..),
+    clientName,
+    genderStat,
+    performSale,
+    unzip',
+    ClientR (..),
+    PersonR (..),
+    greet
+    ) where
+
+import Data.Char
+
+data Client = GovOrg     String
+            | Company    String Integer Person Bool
+            | Individual Person Bool
+            deriving Show
+
+data Person = Person String String Gender
+            deriving Show
+
+data Gender = Male | Female | Unknown
+            deriving Show
+
+data TimeMachine = TimeMachine { info :: TimeMachineInfo
+                               , price :: Float } deriving (Show, Eq)
+
+data Producer = Producer { name :: String } deriving (Show, Eq)
+
+data TimeMachineInfo = TimeMachineInfo { producer :: Producer
+                                       , model :: Int
+                                       , new :: Bool } deriving (Show, Eq)  
+
+clientName :: Client -> String
+clientName client = case client of
+    GovOrg name -> name
+    Company name _ _ _ -> name
+    Individual (Person fName lName _) _ -> fName ++ " " ++ lName
+
+companyName :: Client -> Maybe String
+companyName client = case client of
+    Company name _ _ _  -> Just name
+    _                   -> Nothing
+
+-- Task 2.5
+-- Write a function to return a count of persons groupped by gender
+-- Write a function for sale time machines
+
+data GenderStatInfo = GenderStatInfo Int Int deriving (Show, Eq)
+
+maleCount :: GenderStatInfo -> Int
+maleCount (GenderStatInfo male _) = male
+
+femaleCount :: GenderStatInfo -> Int
+femaleCount (GenderStatInfo _ female) = female
+
+countGender :: GenderStatInfo -> Gender -> GenderStatInfo
+countGender stat Male   = GenderStatInfo ((maleCount stat) + 1) (femaleCount stat)
+countGender stat Female = GenderStatInfo (maleCount stat) ((femaleCount stat) + 1)
+countGender stat Unknown = stat
+
+genderStat :: [Client] -> GenderStatInfo
+genderStat clients = 
+    let calc [] stats = stats
+        calc (client:xs) stats = 
+            let applyStat (Individual (Person _ _ gender) _) stat = countGender stat gender
+                applyStat _ stat                                  = stat
+            in calc xs (applyStat client stats)
+    in calc clients (GenderStatInfo 0 0)
+
+
+performSale :: [TimeMachine] -> Float -> [TimeMachine]
+performSale [] _ = []
+
+-- Perform sale impl
+-- performSale (x:xs) sale = [case x of
+--                       (TimeMachine info gross) -> (TimeMachine info (gross * sale))] 
+--                                                     ++ (performSale xs sale)
+
+-- Task 2.7 Perform sale with record syntax
+performSale (machine@(TimeMachine { .. }):xs) sale = 
+    let currentPrice = price
+     in [machine { price = currentPrice * sale }] ++ (performSale xs sale)                                              
+
+-- Task 2.6
+-- Write a function to unzip list of tuples                                                    
+
+plus :: (Int, Int) -> ([Int], [Int]) -> ([Int], [Int])
+plus (x, y) (xs, ys) = ([x] ++ xs, [y] ++ ys)                                                      
+
+unzip' :: [(Int, Int)] -> ([Int], [Int])
+unzip' [] = ([], [])
+unzip' (x:xs) = plus ((fst x), (snd x)) (unzip' xs)
+
+
+responsibility :: Client -> String
+responsibility (Company r _ _ _ ) = r
+responsibility _ = "Unknown"
+
+specialClient :: Client -> Bool
+specialClient (clientName -> "Mr. Alejandro") = True
+specialClient (responsibility -> "Director") = True
+specialClient _ = False 
+
+
+-- Records
+
+data ClientR = GovOrgR  { clientRName :: String } 
+             | CompanyR { clientRName :: String
+                        , companyId :: Integer
+                        , person :: PersonR
+                        , duty :: String }
+             | IndividualR { person :: PersonR }
+             deriving Show
+
+data PersonR = PersonR { firstName :: String
+                       , lastName :: String }
+                       deriving Show
+
+greet :: ClientR -> String
+greet IndividualR { person = PersonR { .. } } = "Hi, " ++ firstName
+greet CompanyR { .. } = "Hello, " ++ clientRName
+greet GovOrgR { } = "Welcome"
+
+nameInCapitals :: PersonR -> PersonR
+nameInCapitals p@(PersonR { firstName = initial:rest }) =
+    let newName = (toUpper initial):rest
+     in p { firstName = newName }
+nameInCapitals p@(PersonR { firstName = ""}) = p
+
+
+-- Default values
+
+data ConnType = TCP | UDP
+data UserProxy = NoProxy | Proxy String
+data Timeout = NoTimeOut | TimeOut Integer
+data ConnOptions = ConnOptions { connType      :: ConnType
+                               , connSpeed     :: Integer
+                               , connProxy     :: UserProxy
+                               , connCaching   :: Bool
+                               , connKeepAlive :: Bool
+                               , connTimeOut   :: Timeout }
+data Connection = Connection
+
+connDefault :: ConnOptions
+connDefault = ConnOptions TCP 0 NoProxy False False NoTimeOut
+
+connect' :: String -> ConnOptions -> Connection
+connect' _ = undefined

src/Chapter2/SimpleFunctions.hs

@@ -0,0 +1,29 @@
+module Chapter2.SimpleFunctions (
+    firstOrEmpty,
+    (+++),
+    reverse2,
+    maxmin
+) where
+
+firstOrEmpty :: [String] -> String
+firstOrEmpty lst = if not (null lst) then head lst else "empty"
+
+(+++) :: String -> String -> String
+lst1 +++ lst2 = if null lst1
+                then lst2
+                else (head lst1) : (tail lst1 +++ lst2)
+
+reverse2 :: String -> String
+reverse2 list = if null list
+                then []
+                else reverse2 (tail list) +++ [head list]
+
+
+maxmin list = let h = head list
+              in if null (tail list)
+                 then (h, h)
+                 else ( if h > t_max then h else t_max
+                      , if h < t_min then h else t_min)
+                      where t = maxmin (tail list)
+                            t_max = fst t
+                            t_min = snd t

src/Lib.hs

@@ -3,4 +3,4 @@ module Lib
     ) where
 
 someFunc :: IO ()
-someFunc = putStrLn "someFunc"
+someFunc = putStrLn "Chapter 2 start"

test/unit/Chapter2/DataTypesSpec.hs

@@ -0,0 +1,40 @@
+module Chapter2.DataTypesSpec where
+
+import Test.Hspec
+import Chapter2.DataTypes
+
+spec :: Spec
+spec = do
+    describe "Prelude.head" $ do
+
+        it "Get client name" $ do
+            clientName (Individual (Person "John" "Black" Male) True) `shouldBe` "John Black"
+
+
+        it "Calculate gender stat" $ do
+            let client1 = (Individual (Person "John" "Black" Male) True)
+                client2 = (Individual (Person "Jack" "White" Male) True)
+                client3 = (Individual (Person "Melissa" "Green" Female) True)
+                client4 = GovOrg "Sony"
+             in genderStat [client1, client2, client3, client4] `shouldBe` (GenderStatInfo 2 1)
+
+
+        it "Sale Timemachines" $ do
+            let timeMachine1 = (TimeMachine (TimeMachineInfo (Producer "Eureka") 6 True) 100)
+                timeMachine2 = (TimeMachine (TimeMachineInfo (Producer "Eureka") 8 True) 200)
+                timeMachine3 = (TimeMachine (TimeMachineInfo (Producer "Eureka") 9 True) 400)
+                result = performSale [timeMachine1, timeMachine2, timeMachine3] 0.5
+                prices = map (\machine -> case machine of
+                                          (TimeMachine _ value) -> value) result
+
+             in prices `shouldBe` [50, 100, 200]
+
+        it "Unzip lists" $ do
+            let input = [(1,2), (3,4), (5,6)]
+             in unzip' input `shouldBe` ([1,3,5], [2,4,6])
+
+        it "Greet clien " $ do
+            let client = IndividualR { person = PersonR { lastName = "Smith", firstName = "John" } }
+                greeting = greet client
+             in greeting `shouldBe` "Hi, John"
+

test/unit/Chapter2/SimpleFunctionsSpec.hs

@@ -0,0 +1,17 @@
+module Chapter2.SimpleFunctionsSpec where
+
+import Test.Hspec
+import Chapter2.SimpleFunctions
+
+spec :: Spec
+spec = do
+    describe "Prelude.head" $ do
+
+        it "reverse the string" $ do
+            reverse2 "hello" `shouldBe` "olleh"
+
+        it "concat two strings" $ do
+            "hello" +++ " world" `shouldBe` "hello world"
+
+        it "find max and min" $ do
+            maxmin [3,4,1,9,6] `shouldBe` (9, 1)

test/unit/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}