Add remaining haskell book exercises
This commit is contained in:
3
Haskell-book/14/morse/.gitignore
vendored
Normal file
3
Haskell-book/14/morse/.gitignore
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
.stack-work/
|
||||
morse.cabal
|
||||
*~
|
||||
3
Haskell-book/14/morse/ChangeLog.md
Normal file
3
Haskell-book/14/morse/ChangeLog.md
Normal file
@@ -0,0 +1,3 @@
|
||||
# Changelog for morse
|
||||
|
||||
## Unreleased changes
|
||||
30
Haskell-book/14/morse/LICENSE
Normal file
30
Haskell-book/14/morse/LICENSE
Normal file
@@ -0,0 +1,30 @@
|
||||
Copyright Author name here (c) 2017
|
||||
|
||||
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.
|
||||
1
Haskell-book/14/morse/README.md
Normal file
1
Haskell-book/14/morse/README.md
Normal file
@@ -0,0 +1 @@
|
||||
# morse
|
||||
2
Haskell-book/14/morse/Setup.hs
Normal file
2
Haskell-book/14/morse/Setup.hs
Normal file
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
59
Haskell-book/14/morse/src/Main.hs
Normal file
59
Haskell-book/14/morse/src/Main.hs
Normal file
@@ -0,0 +1,59 @@
|
||||
module Main where
|
||||
|
||||
import Control.Monad (forever, when)
|
||||
import Data.List (intercalate)
|
||||
import Data.Traversable (traverse)
|
||||
import Morse (stringToMorse, morseToChar)
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit (exitFailure, exitSuccess)
|
||||
import System.IO (hGetLine, hIsEOF, stdin)
|
||||
|
||||
convertToMorse :: IO ()
|
||||
convertToMorse = forever $ do
|
||||
weAreDone <- hIsEOF stdin
|
||||
when weAreDone exitSuccess
|
||||
|
||||
line <- hGetLine stdin
|
||||
convertLine line
|
||||
|
||||
where convertLine line = do
|
||||
let morse = stringToMorse line
|
||||
case morse of
|
||||
(Just str) -> putStrLn (intercalate " " str)
|
||||
Nothing -> do
|
||||
putStrLn $ "ERROR: " ++ line
|
||||
exitFailure
|
||||
|
||||
convertFromMorse :: IO ()
|
||||
convertFromMorse = forever $ do
|
||||
weAreDone <- hIsEOF stdin
|
||||
when weAreDone exitSuccess
|
||||
|
||||
line <- hGetLine stdin
|
||||
convertLine line
|
||||
|
||||
where
|
||||
convertLine line = do
|
||||
let decoded :: Maybe String
|
||||
decoded = traverse morseToChar (words line)
|
||||
|
||||
case decoded of
|
||||
(Just s) -> putStrLn s
|
||||
Nothing -> do
|
||||
putStrLn $ "ERROR: " ++ line
|
||||
exitFailure
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
mode <- getArgs
|
||||
case mode of
|
||||
[arg] ->
|
||||
case arg of
|
||||
"from" -> convertFromMorse
|
||||
"to" -> convertToMorse
|
||||
_ -> argError
|
||||
_ -> argError
|
||||
|
||||
where argError = do
|
||||
putStrLn "Please specify the first argument as being 'from' or 'to' morse, such as: morse to"
|
||||
exitFailure
|
||||
68
Haskell-book/14/morse/src/Morse.hs
Normal file
68
Haskell-book/14/morse/src/Morse.hs
Normal file
@@ -0,0 +1,68 @@
|
||||
module Morse
|
||||
( Morse
|
||||
, charToMorse
|
||||
, morseToChar
|
||||
, stringToMorse
|
||||
, letterToMorse
|
||||
, morseToLetter
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
type Morse = String
|
||||
|
||||
letterToMorse :: (M.Map Char Morse)
|
||||
letterToMorse = M.fromList [
|
||||
('a', ".-")
|
||||
, ('b', "-...")
|
||||
, ('c', "-.-.")
|
||||
, ('d', "-..")
|
||||
, ('e', ".")
|
||||
, ('f', "..-.")
|
||||
, ('g', "--.")
|
||||
, ('h', "....")
|
||||
, ('i', "..")
|
||||
, ('j', ".---")
|
||||
, ('k', "-.-")
|
||||
, ('l', ".-..")
|
||||
, ('m', "--")
|
||||
, ('n', "-.")
|
||||
, ('o', "---")
|
||||
, ('p', ".--.")
|
||||
, ('q', "--.-")
|
||||
, ('r', ".-.")
|
||||
, ('s', "...")
|
||||
, ('t', "-")
|
||||
, ('u', "..-")
|
||||
, ('v', "...-")
|
||||
, ('w', ".--")
|
||||
, ('x', "-..-")
|
||||
, ('y', "-.--")
|
||||
, ('z', "--..")
|
||||
, ('1', ".----")
|
||||
, ('2', "..---")
|
||||
, ('3', "...--")
|
||||
, ('4', "....-")
|
||||
, ('5', ".....")
|
||||
, ('6', "-....")
|
||||
, ('7', "--...")
|
||||
, ('8', "---..")
|
||||
, ('9', "----.")
|
||||
, ('0', "-----")
|
||||
]
|
||||
|
||||
morseToLetter :: M.Map Morse Char
|
||||
morseToLetter =
|
||||
M.foldWithKey (flip M.insert) M.empty
|
||||
letterToMorse
|
||||
|
||||
charToMorse :: Char -> Maybe Morse
|
||||
charToMorse c =
|
||||
M.lookup c letterToMorse
|
||||
|
||||
stringToMorse :: String -> Maybe [Morse]
|
||||
stringToMorse s =
|
||||
sequence $ fmap charToMorse s
|
||||
|
||||
morseToChar :: Morse -> Maybe Char
|
||||
morseToChar m = M.lookup m morseToLetter
|
||||
26
Haskell-book/14/morse/src/WordNumber.hs
Normal file
26
Haskell-book/14/morse/src/WordNumber.hs
Normal file
@@ -0,0 +1,26 @@
|
||||
module WordNumber where
|
||||
|
||||
import Data.List (unfoldr, intercalate)
|
||||
import Data.Maybe (Maybe(..))
|
||||
|
||||
digitToWord :: Int -> String
|
||||
digitToWord 0 = "zero"
|
||||
digitToWord 1 = "one"
|
||||
digitToWord 2 = "two"
|
||||
digitToWord 3 = "three"
|
||||
digitToWord 4 = "four"
|
||||
digitToWord 5 = "five"
|
||||
digitToWord 6 = "six"
|
||||
digitToWord 7 = "seven"
|
||||
digitToWord 8 = "eight"
|
||||
digitToWord 9 = "nine"
|
||||
digitToWord _ = ""
|
||||
|
||||
digits :: Int -> [Int]
|
||||
digits n = reverse $ unfoldr unfold n
|
||||
where unfold x
|
||||
| x == 0 = Nothing
|
||||
| otherwise = Just ((mod x 10), (div x 10))
|
||||
|
||||
wordNumber :: Int -> String
|
||||
wordNumber n = intercalate "-" $ map digitToWord (digits n)
|
||||
66
Haskell-book/14/morse/stack.yaml
Normal file
66
Haskell-book/14/morse/stack.yaml
Normal file
@@ -0,0 +1,66 @@
|
||||
# This file was automatically generated by 'stack init'
|
||||
#
|
||||
# Some commonly used options have been documented as comments in this file.
|
||||
# For advanced use and comprehensive documentation of the format, please see:
|
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||
# A snapshot resolver dictates the compiler version and the set of packages
|
||||
# to be used for project dependencies. For example:
|
||||
#
|
||||
# resolver: lts-3.5
|
||||
# resolver: nightly-2015-09-21
|
||||
# resolver: ghc-7.10.2
|
||||
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||
# resolver:
|
||||
# name: custom-snapshot
|
||||
# location: "./custom-snapshot.yaml"
|
||||
resolver: lts-9.17
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
#
|
||||
# packages:
|
||||
# - some-directory
|
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||
# - location:
|
||||
# git: https://github.com/commercialhaskell/stack.git
|
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
# extra-dep: true
|
||||
# subdirs:
|
||||
# - auto-update
|
||||
# - wai
|
||||
#
|
||||
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||
# will not be run. This is useful for tweaking upstream packages.
|
||||
packages:
|
||||
- .
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
# (e.g., acme-missiles-0.3)
|
||||
# extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
# flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
# extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
#
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: ">=1.6"
|
||||
#
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
||||
12
Haskell-book/14/morse/stack.yaml.lock
Normal file
12
Haskell-book/14/morse/stack.yaml.lock
Normal file
@@ -0,0 +1,12 @@
|
||||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/topics/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: 82ff94eacdc32a857e5aec82268644fdc3d5bfca07692ceeeb97e2d8ce5726ef
|
||||
size: 535915
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/17.yaml
|
||||
original: lts-9.17
|
||||
16
Haskell-book/14/morse/tests/CoArbitrary.hs
Normal file
16
Haskell-book/14/morse/tests/CoArbitrary.hs
Normal file
@@ -0,0 +1,16 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module CoArbitrary where
|
||||
|
||||
import GHC.Generics
|
||||
import Test.QuickCheck
|
||||
|
||||
data Bool' = True' | False' deriving (Generic)
|
||||
|
||||
instance CoArbitrary Bool'
|
||||
|
||||
trueGen :: Gen Int
|
||||
trueGen = coarbitrary True' arbitrary
|
||||
|
||||
falseGen :: Gen Int
|
||||
falseGen = coarbitrary False' arbitrary
|
||||
24
Haskell-book/14/morse/tests/WordNumberTest.hs
Normal file
24
Haskell-book/14/morse/tests/WordNumberTest.hs
Normal file
@@ -0,0 +1,24 @@
|
||||
module Main where
|
||||
|
||||
import Test.Hspec
|
||||
import WordNumber (digitToWord, digits, wordNumber)
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "digitToWord" $ do
|
||||
it "returns zero for 0" $ do
|
||||
digitToWord 0 `shouldBe`"zero"
|
||||
it "returns one for 1" $ do
|
||||
digitToWord 1 `shouldBe` "one"
|
||||
|
||||
describe "digits" $ do
|
||||
it "returns [1] for 1" $ do
|
||||
digits 1 `shouldBe` [1]
|
||||
it "returns [1, 0, 0] for 100" $ do
|
||||
digits 100 `shouldBe` [1, 0, 0]
|
||||
|
||||
describe "wordNumber" $ do
|
||||
it "one-zero-zero given 100" $ do
|
||||
wordNumber 100 `shouldBe` "one-zero-zero"
|
||||
it "nine-zero-zero-one for 9001" $ do
|
||||
wordNumber 9001 `shouldBe` "nine-zero-zero-one"
|
||||
86
Haskell-book/14/morse/tests/tests.hs
Normal file
86
Haskell-book/14/morse/tests/tests.hs
Normal file
@@ -0,0 +1,86 @@
|
||||
module Main where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Morse
|
||||
import Test.QuickCheck
|
||||
import Test.QuickCheck.Gen (oneof)
|
||||
|
||||
allowedChars :: [Char]
|
||||
allowedChars = M.keys letterToMorse
|
||||
|
||||
allowedMorse :: [Morse]
|
||||
allowedMorse = M.elems letterToMorse
|
||||
|
||||
charGen :: Gen Char
|
||||
charGen = elements allowedChars
|
||||
|
||||
morseGen :: Gen Morse
|
||||
morseGen = elements allowedMorse
|
||||
|
||||
prop_thereAndBackAgain :: Property
|
||||
prop_thereAndBackAgain =
|
||||
forAll charGen (\c -> ((charToMorse c) >>= morseToChar) == Just c)
|
||||
|
||||
main' :: IO ()
|
||||
main' = quickCheck prop_thereAndBackAgain
|
||||
|
||||
data Trivial = Trivial deriving (Eq, Show)
|
||||
|
||||
trivialGen :: Gen Trivial
|
||||
trivialGen = return Trivial
|
||||
|
||||
instance Arbitrary Trivial where
|
||||
arbitrary = trivialGen
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
sample trivialGen
|
||||
|
||||
data Identity a = Identity a deriving (Eq, Show)
|
||||
|
||||
identityGen :: Arbitrary a => Gen (Identity a)
|
||||
identityGen = do
|
||||
a <- arbitrary
|
||||
return (Identity a)
|
||||
|
||||
instance Arbitrary a => Arbitrary (Identity a) where
|
||||
arbitrary = identityGen
|
||||
|
||||
identityGenInt :: Gen (Identity Int)
|
||||
identityGenInt = identityGen
|
||||
|
||||
data Pair a b = Pair a b deriving (Eq, Show)
|
||||
|
||||
pairGen :: (Arbitrary a, Arbitrary b) => Gen (Pair a b)
|
||||
pairGen = do
|
||||
a <- arbitrary
|
||||
b <- arbitrary
|
||||
return (Pair a b)
|
||||
|
||||
instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
|
||||
arbitrary = pairGen
|
||||
|
||||
pairGenIntString :: Gen (Pair Int String)
|
||||
pairGenIntString = pairGen
|
||||
|
||||
data Sum a b = First a | Second b deriving (Eq, Show)
|
||||
|
||||
sumGenEqual :: Gen (Sum Char Int)
|
||||
sumGenEqual = do
|
||||
a <- arbitrary
|
||||
b <- arbitrary
|
||||
oneof [return $ First a,
|
||||
return $ Second b]
|
||||
|
||||
sumGenCharInt :: Gen (Sum Char Int)
|
||||
sumGenCharInt = sumGenEqual
|
||||
|
||||
sumGenFirstPls :: (Arbitrary a, Arbitrary b) => Gen (Sum a b)
|
||||
sumGenFirstPls = do
|
||||
a <- arbitrary
|
||||
b <- arbitrary
|
||||
frequency [(10, return $ First a),
|
||||
(1, return $ Second b)]
|
||||
|
||||
sumGenCharIntFirst :: Gen (Sum Char Int)
|
||||
sumGenCharIntFirst = sumGenFirstPls
|
||||
Reference in New Issue
Block a user