├── README.md ├── s2 ├── add.hs ├── compass.hs ├── expression.hs ├── greet.hs └── headtail.hs └── s3-4 └── words ├── 4.1.test.hs ├── LICENSE ├── Setup.hs ├── app └── Main.hs ├── src ├── Data.hs └── Lib.hs ├── stack.yaml ├── test └── Spec.hs └── words.cabal /README.md: -------------------------------------------------------------------------------- 1 | # Sample code for "Learning Haskell" tutorial 2 | 3 | Video tutorial at: 4 | 5 | * https://www.packtpub.com/gb/application-development/learning-haskell-programming 6 | * https://www.linkedin.com/learning/learning-haskell-programming/the-course-overview?u=26889090 7 | * https://learning.oreilly.com/videos/learning-haskell-programming/9781786465542 8 | -------------------------------------------------------------------------------- /s2/add.hs: -------------------------------------------------------------------------------- 1 | add1 :: Int -> Int -> Int 2 | add1 a b = a + b 3 | 4 | add2 :: Int -> Int -> Int 5 | add2 a b = (+) a b 6 | 7 | add3 :: Int -> Int -> Int 8 | add3 = (+) 9 | 10 | add4 :: Num a => a -> a -> a 11 | add4 = (+) 12 | 13 | -------------------------------------------------------------------------------- /s2/compass.hs: -------------------------------------------------------------------------------- 1 | data Compass = North | East | South | West 2 | deriving (Eq, Ord, Enum, Show) 3 | -------------------------------------------------------------------------------- /s2/expression.hs: -------------------------------------------------------------------------------- 1 | data Expression = Number Int 2 | | Add Expression Expression 3 | | Subtract Expression Expression 4 | deriving (Eq, Ord, Show) 5 | 6 | calculate :: Expression -> Int 7 | calculate (Number x) = x 8 | calculate (Add x y) = (calculate x) + (calculate y) 9 | calculate (Subtract x y) = (calculate x) - (calculate y) 10 | -------------------------------------------------------------------------------- /s2/greet.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn (greet "World") 3 | 4 | greeting = "Hello" 5 | 6 | greet :: String -> String 7 | greet who = greeting ++ ", " ++ who 8 | -------------------------------------------------------------------------------- /s2/headtail.hs: -------------------------------------------------------------------------------- 1 | newHead :: [a] -> a 2 | newHead [] = error "empty list" 3 | newHead (x:_) = x 4 | 5 | newTail :: [a] -> [a] 6 | newTail [] = error "empty list" 7 | newTail (_:xs) = xs 8 | -------------------------------------------------------------------------------- /s3-4/words/4.1.test.hs: -------------------------------------------------------------------------------- 1 | -- sample coordinate grid 2 | coords = [ [(0,0),(0,1),(0,2),(0,3),(0,4),(0,5),(0,6),(0,7)] 3 | , [(1,0),(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(1,7)] 4 | , [(2,0),(2,1),(2,2),(2,3),(2,4),(2,5),(2,6),(2,7)] 5 | , [(3,0),(3,1),(3,2),(3,3),(3,4),(3,5),(3,6),(3,7)] 6 | , [(4,0),(4,1),(4,2),(4,3),(4,4),(4,5),(4,6),(4,7)] 7 | , [(5,0),(5,1),(5,2),(5,3),(5,4),(5,5),(5,6),(5,7)] 8 | , [(6,0),(6,1),(6,2),(6,3),(6,4),(6,5),(6,6),(6,7)] 9 | , [(7,0),(7,1),(7,2),(7,3),(7,4),(7,5),(7,6),(7,7)] 10 | ] 11 | 12 | -- copy of word grid 13 | grid = [ "__C________R___" 14 | , "__SI________U__" 15 | , "__HASKELL____B_" 16 | , "__A__A_____S__Y" 17 | , "__R___B___C____" 18 | , "__PHP____H_____" 19 | , "____S_LREP_____" 20 | , "____I__M_Y__L__" 21 | , "____L_E__T_O___" 22 | , "_________HB____" 23 | , "_________O_____" 24 | , "________CN_____" 25 | ] 26 | 27 | -- variant of outputGrid, for arbitrary Show-able structures 28 | og :: Show a => [a] -> IO () 29 | og = putStrLn . unlines . map show 30 | 31 | -- check if divisible by 2 32 | div2 x = x `mod` 2 == 0 33 | -------------------------------------------------------------------------------- /s3-4/words/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Hakim (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Hakim nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /s3-4/words/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /s3-4/words/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Lib 4 | import Data 5 | import System.IO 6 | import System.Random 7 | 8 | main :: IO () 9 | main = do 10 | gen <- newStdGen 11 | let filledInGrid = fillInBlanks gen grid 12 | game = makeGame filledInGrid languages 13 | hSetBuffering stdout NoBuffering 14 | playTurn game 15 | 16 | playTurn game = do 17 | putStrLn . formatGame $ game 18 | putStr "Please enter a word> " 19 | word <- getLine 20 | let newGame = playGame game word 21 | if completed newGame then 22 | putStrLn "Congratulations!" 23 | else 24 | playTurn newGame 25 | -------------------------------------------------------------------------------- /s3-4/words/src/Data.hs: -------------------------------------------------------------------------------- 1 | module Data ( grid 2 | , languages ) 3 | where 4 | 5 | grid = [ "__C________R___" 6 | , "__SI________U__" 7 | , "__HASKELL____B_" 8 | , "__A__A_____S__Y" 9 | , "__R___B___C____" 10 | , "__PHP____H_____" 11 | , "____S_LREP_____" 12 | , "____I__M_Y__L__" 13 | , "____L_E__T_O___" 14 | , "_________HB____" 15 | , "_________O_____" 16 | , "________CN_____" 17 | ] 18 | 19 | languages = [ "BASIC" 20 | , "COBOL" 21 | , "CSHARP" 22 | , "HASKELL" 23 | , "LISP" 24 | , "PERL" 25 | , "PHP" 26 | , "PYTHON" 27 | , "RUBY" 28 | , "SCHEME" 29 | ] 30 | -------------------------------------------------------------------------------- /s3-4/words/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( formatGrid 3 | , outputGrid 4 | , findWord 5 | , findWords 6 | , findWordInLine 7 | , findWordInCellLinePrefix 8 | , skew 9 | , zipOverGrid 10 | , zipOverGridWith 11 | , gridWithCoords 12 | , cell2char 13 | , Cell(Cell,Indent) 14 | , Game(gameGrid, gameWords) 15 | , makeGame 16 | , totalWords 17 | , score 18 | , completed 19 | , playGame 20 | , formatGame 21 | , makeRandomGrid 22 | , fillInBlanks 23 | ) where 24 | 25 | import Data.List (isInfixOf, transpose) 26 | import Data.Maybe (catMaybes, listToMaybe) 27 | import Data.Char (toLower) 28 | import System.Random 29 | import qualified Data.Map as M 30 | 31 | data Game = Game { 32 | gameGrid :: Grid Cell, 33 | gameWords :: M.Map String (Maybe [Cell]) 34 | } 35 | deriving Show 36 | 37 | data Cell = Cell (Integer, Integer) Char 38 | | Indent 39 | deriving (Eq, Ord, Show) 40 | type Grid a = [[a]] 41 | 42 | makeGame :: Grid Char -> [String] -> Game 43 | makeGame grid words = 44 | let gwc = gridWithCoords grid 45 | tuplify word = (word, Nothing) 46 | list = map tuplify words 47 | dict = M.fromList list 48 | in Game gwc dict 49 | 50 | totalWords :: Game -> Int 51 | totalWords game = length . M.keys $ gameWords game 52 | 53 | score :: Game -> Int 54 | score game = length . catMaybes . M.elems $ gameWords game 55 | 56 | completed :: Game -> Bool 57 | completed game = score game == totalWords game 58 | 59 | playGame :: Game -> String -> Game 60 | playGame game word | not $ M.member word (gameWords game) = game 61 | playGame game word = 62 | let grid = gameGrid game 63 | foundWord = findWord grid word 64 | in case foundWord of 65 | Nothing -> game 66 | Just cs -> 67 | let dict = gameWords game 68 | newDict = M.insert word foundWord dict 69 | in game { gameWords = newDict } 70 | 71 | formatGame :: Game -> String 72 | formatGame game = formatGameGrid game 73 | ++ "\n\n" 74 | ++ (show $ score game) 75 | ++ "/" 76 | ++ (show $ totalWords game) 77 | 78 | makeRandomGrid gen = 79 | let (gen1, gen2) = split gen 80 | row = randomRs ('A','Z') gen1 81 | in row : makeRandomGrid gen2 82 | 83 | fillInBlanks gen grid = 84 | let r = makeRandomGrid gen 85 | fill '_' r = r 86 | fill c _ = c 87 | in zipOverGridWith fill grid r 88 | 89 | zipOverGrid :: Grid a -> Grid b -> Grid (a,b) 90 | zipOverGrid = zipWith zip 91 | 92 | zipOverGridWith :: (a -> b -> c) -> Grid a -> Grid b -> Grid c 93 | zipOverGridWith = zipWith . zipWith 94 | 95 | mapOverGrid :: (a -> b) -> Grid a -> Grid b 96 | mapOverGrid = map . map 97 | 98 | coordsGrid :: Grid (Integer, Integer) 99 | coordsGrid = 100 | let rows = map repeat [0..] 101 | cols = repeat [0..] 102 | in zipOverGrid rows cols 103 | 104 | gridWithCoords :: Grid Char -> Grid Cell 105 | gridWithCoords grid = zipOverGridWith Cell coordsGrid grid 106 | 107 | outputGrid :: Grid Cell -> IO () 108 | outputGrid grid = putStrLn (formatGrid grid) 109 | 110 | formatGameGrid :: Game -> String 111 | formatGameGrid game = 112 | let grid = gameGrid game 113 | dict = gameWords game :: M.Map String (Maybe [Cell]) 114 | cellSet = concat . catMaybes . M.elems $ dict 115 | formatCell cell = 116 | let char = cell2char cell 117 | in if cell `elem` cellSet then char else toLower char 118 | charGrid = mapOverGrid formatCell grid 119 | in unlines charGrid 120 | 121 | formatGrid :: Grid Cell -> String 122 | formatGrid = unlines . mapOverGrid cell2char 123 | 124 | cell2char :: Cell -> Char 125 | cell2char (Cell _ c) = c 126 | cell2char Indent = '?' 127 | 128 | getLines :: Grid Cell -> [[Cell]] 129 | getLines grid = 130 | let horizontal = grid 131 | vertical = transpose grid 132 | diagonal1 = diagonalize grid 133 | diagonal2 = diagonalize (map reverse grid) 134 | lines = horizontal ++ vertical ++ diagonal1 ++ diagonal2 135 | in lines ++ (map reverse lines) 136 | 137 | diagonalize :: Grid Cell -> Grid Cell 138 | diagonalize = transpose . skew 139 | 140 | skew :: Grid Cell -> Grid Cell 141 | skew [] = [] 142 | skew (l:ls) = l : skew (map indent ls) 143 | where indent line = Indent : line 144 | 145 | findWord :: Grid Cell -> String -> Maybe [Cell] 146 | findWord grid word = 147 | let lines = getLines grid 148 | foundWords = map (findWordInLine word) lines 149 | in listToMaybe (catMaybes foundWords) 150 | 151 | findWords :: Grid Cell -> [String] -> [[Cell]] 152 | findWords grid words = 153 | let foundWords = map (findWord grid) words 154 | in catMaybes foundWords 155 | 156 | findWordInLine :: String -> [Cell] -> Maybe [Cell] 157 | findWordInLine _ [] = Nothing 158 | findWordInLine word line = 159 | let found = findWordInCellLinePrefix [] word line 160 | in case found of 161 | Nothing -> findWordInLine word (tail line) 162 | cs@(Just _) -> cs 163 | 164 | findWordInCellLinePrefix :: [Cell] -> String -> [Cell] -> Maybe [Cell] 165 | findWordInCellLinePrefix acc (x:xs) (c:cs) | x == cell2char c 166 | = findWordInCellLinePrefix (c : acc) xs cs 167 | findWordInCellLinePrefix acc [] _ = Just $ reverse acc 168 | findWordInCellLinePrefix _ _ _ = Nothing 169 | -------------------------------------------------------------------------------- /s3-4/words/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-7.8 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | flags: {} 46 | 47 | # Extra package databases containing global packages 48 | extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.2" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor -------------------------------------------------------------------------------- /s3-4/words/test/Spec.hs: -------------------------------------------------------------------------------- 1 | import Test.Hspec 2 | import Lib 3 | import Data 4 | 5 | gwc = gridWithCoords grid 6 | 7 | testFindWord word = 8 | let (Just result) = findWord gwc word 9 | string = map cell2char result 10 | in string `shouldBe` word 11 | 12 | main :: IO () 13 | main = hspec $ do 14 | describe "formatGrid" $ do 15 | it "Should concatenate every line with a newline" $ do 16 | (formatGrid (gridWithCoords ["abc", "def", "ghi"])) `shouldBe` "abc\ndef\nghi\n" 17 | 18 | describe "findWord" $ do 19 | it "Should find words that exist on the Grid" $ do 20 | testFindWord "HASKELL" 21 | testFindWord "PERL" 22 | it "Should not find words that do not exist on the Grid" $ do 23 | findWord gwc "HAMSTER" `shouldBe` Nothing 24 | 25 | describe "findWords" $ do 26 | it "Should find all the words that exist on the Grid" $ do 27 | let found = findWords gwc languages 28 | asString = map (map cell2char) found 29 | asString `shouldBe` languages 30 | it "Should not find words that do not exist on the Grid" $ do 31 | findWords gwc ["FRENCH", "GERMAN", "ENGLISH"] `shouldBe` [] 32 | -------------------------------------------------------------------------------- /s3-4/words/words.cabal: -------------------------------------------------------------------------------- 1 | name: words 2 | version: 0.1.0.0 3 | synopsis: Initial project template from stack 4 | description: Please see README.md 5 | homepage: https://github.com/osfameron/words#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Hakim 9 | maintainer: hakim@greenokapi.net 10 | copyright: BSD 11 | category: Example 12 | build-type: Simple 13 | -- extra-source-files: 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | , Data 20 | build-depends: base >= 4.7 && < 5 21 | , containers 22 | , random 23 | default-language: Haskell2010 24 | 25 | executable words 26 | hs-source-dirs: app 27 | main-is: Main.hs 28 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -dynamic 29 | build-depends: base 30 | , words 31 | , random 32 | default-language: Haskell2010 33 | 34 | test-suite words-test 35 | type: exitcode-stdio-1.0 36 | hs-source-dirs: test 37 | main-is: Spec.hs 38 | build-depends: base 39 | , words 40 | , hspec 41 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 42 | default-language: Haskell2010 43 | 44 | source-repository head 45 | type: git 46 | location: https://github.com/osfameron/words 47 | --------------------------------------------------------------------------------