Add the haskell book

This commit is contained in:
2025-12-09 16:32:32 +01:00
parent c95abc31d6
commit 3624c712d7
67 changed files with 1576 additions and 0 deletions

8
Haskell-book/02/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,17 @@
{
"name": "02",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-math": "^2.1.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,28 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Math (pi)
--
-- 2.5 Comprehensive check
--
mulSquare :: Number -> Number
mulSquare x = pi * (x * x)
waxOn :: Int
waxOn = x * 5
where x = y * y
y = z + 8
z = 7
triple :: Int -> Int
triple x = x * 3
waxOff :: Int -> Int
waxOff = triple
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "Hello sailor!"

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/03/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,18 @@
{
"name": "03",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-arrays": "^4.2.1",
"purescript-strings": "^3.3.1"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,45 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.String (singleton, drop, take)
import Data.String.Unsafe (charAt)
-- Given
-- "Curry is awesome"
-- Return
-- "Curry is awesome!"
a :: String -> String
a x = x <> "!"
-- Given
-- "Curry is awesome!"
-- Return
-- "y"
b :: String -> String
b x = singleton $ charAt 4 x
-- Given
-- "Curry is awesome!"
-- Return
-- "awesome!"
c :: String -> String
c = drop 9
-- If you apply your function to this value:
-- "Curry is awesome"
-- Your function should return
-- 'r'
thirdLetter :: String -> Char
thirdLetter = charAt 2
letterIndex :: Int -> Char
letterIndex x = charAt x "Curry is awesome!"
rvrs :: String -> String
rvrs inp = (drop 9 inp) <> (drop 5 $ take 9 inp) <> (take 5 inp)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log $ rvrs "Curry is awesome"

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/04/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,20 @@
{
"name": "04",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-tuples": "^4.1.0",
"purescript-lists": "^4.10.0",
"purescript-arrays": "^4.2.1",
"purescript-strings": "^3.3.1"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,33 @@
module Ex where
import Prelude
import Data.Array (tail, reverse)
import Data.Maybe (Maybe(..))
import Data.String (toCharArray)
import Data.Tuple (fst, snd, Tuple(..))
awesome :: Array String
awesome = ["Papuchon", "curry", ":)"]
alsoAwesome :: Array String
alsoAwesome = ["Quake", "The Simons"]
allAwesome :: Array (Array String)
allAwesome = [awesome, alsoAwesome]
length :: forall a. Array a -> Int
length n = length' 0 (tail n)
where length' i Nothing = i
length' i (Just k) = length' (i + 1) (tail k)
isPalindrome :: String -> Boolean
isPalindrome x = toCharArray x == reverse (toCharArray x)
myAbs :: Int -> Int
myAbs a = if a > 0 then a else -a
f :: forall a b c d. Tuple a b -> Tuple c d -> Tuple (Tuple b d) (Tuple a c)
f x y = Tuple (Tuple (snd x) (snd y)) (Tuple (fst x) (fst y))
f' :: forall a b. (Tuple a b) -> a
f' (Tuple a b) = a

View File

@@ -0,0 +1,9 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "Hello sailor!"

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/05/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,21 @@
{
"name": "05",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-tuples": "^4.1.0",
"purescript-strings": "^3.3.1",
"purescript-arrays": "^4.2.1",
"purescript-lists": "^4.10.0",
"purescript-unsafe-coerce": "^3.0.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,14 @@
-- arith3broken.hs
module Arith3Broken where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log $ show (1 + 5)
log "10"
log $ show (negate $ -1)
log $ show ((+) 0 blah)
where blah = negate 1

View File

@@ -0,0 +1,36 @@
module Ex where
import Data.Array (head)
import Data.Maybe (Maybe)
import Data.Tuple (Tuple(..))
import Prelude
functionH :: forall a. Array a -> Maybe a
functionH x = head x
functionC :: forall a. Ord a => a -> a -> Boolean
functionC x y = if (x > y) then true else false
functionS :: forall a b. Tuple a b -> b
functionS (Tuple x y) = y
i :: forall a. a -> a
i x = x
c :: forall a b. a -> b -> a
c x _ = x
c'' :: forall a b. b -> a -> b
c'' x _ = x
c' :: forall a b. a -> b -> b
c' _ y = y
r :: forall a. Array a -> Array a
r x = x
co :: forall a b c. (b -> c) -> (a -> b) -> a -> c
co f f' x = f $ f' x
a :: forall a c. (a -> c) -> a -> a
a _ x = x

View File

@@ -0,0 +1,9 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE)
import Arith3Broken as Arith3Broken
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = Arith3Broken.main

View File

@@ -0,0 +1,14 @@
module Sing where
import Prelude
fstString :: String -> String
fstString x = x <> " in the rain"
sndString :: String -> String
sndString x = x <> " over the rainbow"
sing :: String
sing = if (x > y) then fstString x else sndString y
where x = "Singin"
y = "Somewhere"

View File

@@ -0,0 +1,47 @@
module TypeKwonDo where
import Data.Tuple (Tuple(..), fst)
import Prelude
import Unsafe.Coerce (unsafeCoerce)
f :: Int -> String
f = unsafeCoerce unit
g :: String -> Char
g = unsafeCoerce unit
h :: Int -> Char
h x = g $ f x
data A
data B
data C
q :: A -> B
q = unsafeCoerce unit
w :: B -> C
w = unsafeCoerce unit
e :: A -> C
e x = w $ q x
data X
data Y
data Z
xz :: X -> Z
xz = unsafeCoerce unit
yz :: Y -> Z
yz = unsafeCoerce unit
xform :: Tuple X Y -> Tuple Z Z
xform (Tuple a b) = Tuple (xz a) (yz b)
munge :: forall x y z w.
(x -> y)
-> (y -> (Tuple w z))
-> x
-> w
munge f1 f2 a = fst (f2 (f1 a))

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/06/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,16 @@
{
"name": "06",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,63 @@
module EqInstances where
-- Exercise: Eq Instances
-- p. 178
import Prelude
-- Ex. 1
data TisAnInteger =
TisAn Int
instance eqTisAn :: Eq TisAnInteger where
eq x y = x == y
-- Ex. 2
data TwoIntegers =
Two Int Int
instance ewTwoIntegers :: Eq TwoIntegers where
eq (Two x y) (Two x' y') = x == x' && y == y'
-- Ex. 3
data StringOrInt =
TisAnInt Int
| TisAString String
instance eqStringOrInt :: Eq StringOrInt where
eq (TisAnInt x) (TisAnInt y) = x == y
eq (TisAString x) (TisAString y) = x == y
eq _ _ = false
-- Ex. 4
data Pair a =
Pair a a
instance eqPair :: Eq a => Eq (Pair a) where
eq (Pair a b) (Pair a' b') = a == a' && b == b'
-- Ex. 5
data Tuple a b =
Tuple a b
instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) where
eq (Tuple a b) (Tuple a' b') = a == a' && b == b'
-- Ex. 6
data Which a =
ThisOne a
| ThatOne a
instance eqWhich :: Eq a => Eq (Which a) where
eq (ThisOne x) (ThisOne y) = x == y
eq (ThatOne x) (ThatOne y) = x == y
eq _ _ = false
-- Ex. 7
data EitherOr a b =
Hello a
| Goodbye b
instance eqEitherOr :: (Eq a, Eq b) => Eq (EitherOr a b) where
eq (Hello _) (Goodbye _) = false
eq (Goodbye _) (Hello _) = false
eq _ _ = true

View File

@@ -0,0 +1,9 @@
module Ex where
import Prelude
--
-- Type-Kwon-Do Two: Electric Typealoo
--
chk :: forall a b. Eq b => (a -> b) -> a -> b -> Boolean
chk f a b = (f a) == b

View File

@@ -0,0 +1,30 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
data DayOfWeek =
Mon | Tue | Weds | Thu | Fri | Sat | Sun
data Date =
Date DayOfWeek Int
instance eqDayOfWeek :: Eq DayOfWeek where
eq Mon Mon = true
eq Tue Tue = true
eq Weds Weds = true
eq Thu Thu = true
eq Fri Fri = true
eq Sat Sat = true
eq Sun Sun = true
eq _ _ = false
instance eqDate :: Eq Date where
eq (Date weekday dayOfMonth)
(Date weekday' dayOfMonth') =
weekday == weekday' && dayOfMonth == dayOfMonth'
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "Hello sailor!"

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/07/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,19 @@
{
"name": "07",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-integers": "^3.1.0",
"purescript-tuples": "^4.1.0",
"purescript-unsafe-coerce": "^3.0.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,13 @@
module ArtfulDodgy where
import Prelude
-- Exercise 1
dodgy :: Int -> Int -> Int
dodgy x y = x + y * 10
oneIsOne :: Int -> Int
oneIsOne = dodgy 1
oneIsTwo :: Int -> Int
oneIsTwo = (flip dodgy) 2

View File

@@ -0,0 +1,24 @@
module CasePractice where
import Data.Int (even)
import Prelude
-- Exercise 1
functionC :: forall a. Ord a => a -> a -> a
functionC x y = case (x > y) of
true -> x
false -> y
-- Exercise 2
isEvenAdd2 :: Int -> Int
isEvenAdd2 n = case even n of
true -> n + 2
false -> n
-- Exercise 3
nums :: Int -> Int
nums x =
case compare x 0 of
LT -> -1
GT -> 1
EQ -> 0

View File

@@ -0,0 +1,70 @@
module Ex where
import Data.Int (fromString)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Prelude
import Unsafe.Coerce (unsafeCoerce)
--
-- Multiple choice
--
-- Exercise 2
f :: Char -> String
f = unsafeCoerce unit
g :: String -> Array String
g = unsafeCoerce unit
e :: Char -> Array String
e = g <<< f
-- Exercise 5
f' :: forall a. a -> a
f' x = x
g' :: Boolean
g' = f' true
--
-- Let's write code
--
-- Exercise 1
tensDigit :: Int -> Int
tensDigit x = d
where xLast = x `div` 10
d = xLast `mod` 10
-- Exercise 2
hunsD :: Int -> Int
hunsD x = d
where xLast = x `div` 100
d = xLast `mod` 10
foldBool :: forall a. a -> a -> Boolean -> a
foldBool x y z = case z of
false -> x
true -> y
findBool2 :: forall a. a -> a -> Boolean -> a
findBool2 x y z
| z = y
| otherwise = x
foldBool3 :: forall a. a -> a -> Boolean -> a
foldBool3 x _ false = x
foldBool3 _ y true = y
-- Exercise 3
g'' :: forall a b c. (a -> b) -> Tuple a c -> Tuple b c
g'' f'' (Tuple a c) = Tuple (f'' a) c
-- Exercise 5
-- id :: a -> a
-- id = x = x
roundTrip :: Int -> Int
roundTrip = fromMaybe <<< fromString <<< show
where fromMaybe (Just n) = n
fromMaybe Nothing = unsafeCoerce unit

View File

@@ -0,0 +1,14 @@
module GrabBags where
import Data.Int (odd)
import Prelude
-- 3 a)
addOneIfOdd :: Int -> Int
addOneIfOdd n = case odd n of
true -> f n
false -> n
where f = \k -> k + 1
addFive :: (Int -> (Int -> Int))
addFive = \x -> \y -> (if x > y then y else x) + 5

View File

@@ -0,0 +1,9 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log (id "4")

View File

@@ -0,0 +1,9 @@
module VarietyPack where
import Data.Tuple (Tuple(..))
f :: forall a b c d e g
. Tuple (Tuple a b) c
-> Tuple (Tuple d e) g
-> Tuple (Tuple a d) (Tuple c g)
f (Tuple (Tuple a b) c) (Tuple (Tuple d e) g) = Tuple (Tuple a d) (Tuple c g)

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/08/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,22 @@
{
"name": "08",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-tuples": "^4.1.0",
"purescript-generics-rep": "^5.3.0",
"purescript-arrays": "^4.2.1",
"purescript-foldable-traversable": "^3.6.1",
"purescript-unfoldable": "^3.0.0",
"purescript-maybe": "^3.0.0"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,72 @@
module Exercises where
import Data.Tuple (Tuple(..), fst, snd)
import Prelude
--
-- Reviewing currying
--
cattyConny :: String -> String -> String
cattyConny x y = x <> " mrow " <> y
flippy :: String -> String -> String
flippy = flip cattyConny
appedCatty :: String -> String
appedCatty = cattyConny "woops"
frappe :: String -> String
frappe = flippy "haha"
--
-- Recursion
--
-- Exercise 2
sumNumbers :: Int -> Int
sumNumbers x = sumNumbers' x 0
where sumNumbers' 0 acc = 0
sumNumbers' n acc = n + (sumNumbers' (n - 1) acc)
-- Exercise 2
multiply :: Int -> Int -> Int
multiply _ 0 = 0
multiply x 1 = x
multiply x y = x + multiply x (y - 1)
--
-- Fixing dividedBy
--
data DividedResult =
Result Int
| DividedByZero
instance showDividedResult :: Show DividedResult where
show :: DividedResult -> String
show (Result n) = show n
show DividedByZero = show "Divided by zero"
go :: Int -> Int -> Int -> Tuple Int Int
go n d count
| n < d = Tuple count n
| otherwise = go (n - d) d (count + 1)
abs :: Int -> Int
abs x
| x < 0 = -x
| otherwise = x
dividedBy :: Int -> Int -> Tuple DividedResult DividedResult
dividedBy num denom
| denom == 0 = Tuple DividedByZero DividedByZero
| (num * denom) < 0 = let tuple = go (abs num) (abs denom) 0 in
Tuple (Result (-(fst tuple))) (Result (snd tuple))
| otherwise = let tuple = go (abs num) (abs denom) 0 in
Tuple (Result (fst tuple)) (Result (snd tuple))
--
-- McCarthy 91 function
--
mc91 :: Int -> Int
mc91 n
| n > 100 = n - 10
| otherwise = mc91 (mc91 (n + 11))

View File

@@ -0,0 +1,9 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "Hello sailor!"

View File

@@ -0,0 +1,30 @@
module WordNumber where
import Data.Array (reverse)
import Data.Maybe (Maybe(..))
import Data.String (joinWith)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (unfoldr)
import Prelude
digitToWord :: Int -> String
digitToWord 0 = "null"
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 -> Array Int
digits n = reverse $ unfoldr unfold n
where unfold x
| x == 0 = Nothing
| otherwise = Just (Tuple (mod x 10) (div x 10))
wordNumber :: Int -> String
wordNumber n = joinWith "-" $ map digitToWord (digits n)

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

8
Haskell-book/09/.gitignore vendored Normal file
View File

@@ -0,0 +1,8 @@
/bower_components/
/node_modules/
/.pulp-cache/
/output/
/generated-docs/
/.psc*
/.purs*
/.psa*

View File

@@ -0,0 +1,21 @@
{
"name": "09",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0",
"purescript-lists": "^4.10.0",
"purescript-arrays": "^4.2.1",
"purescript-maybe": "^3.0.0",
"purescript-enums": "^3.2.1",
"purescript-strings": "^3.3.1"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}
}

View File

@@ -0,0 +1,15 @@
module Cipher where
import Data.Char (fromCharCode, toCharCode)
import Data.String (fromCharArray, toCharArray)
import Prelude
caesar :: Int -> String -> String
caesar key s = fromCharArray $ map shiftRight (toCharArray s)
where shiftRight char = fromCharCode $ mod (ord char) 26
ord = (add key) <<< toCharCode
unCaesar :: Int -> String -> String
unCaesar key s = fromCharArray $ map shiftLeft (toCharArray s)
where shiftLeft char = fromCharCode $ ord char
ord chr = ((toCharCode chr) - (mod key 26)) + 26

View File

@@ -0,0 +1,15 @@
module EnumFromTo where
import Data.Array ((:), reverse)
import Data.Enum (class Enum, succ)
import Data.Maybe (Maybe(..))
import Prelude
enumFromTo :: forall a. Enum a => a -> a -> Array a
enumFromTo start end = reverse $ enumFromTo' [] (Just start)
where enumFromTo' :: Array a -> Maybe a -> Array a
enumFromTo' acc (Just start')
| start' > end = acc
| start' == end = start' : acc
| otherwise = enumFromTo' (start' : acc) (succ start')
enumFromTo' acc Nothing = acc

View File

@@ -0,0 +1,73 @@
module Exercises where
-- direct recursion, not using (&&)
myAnd :: [Bool] -> Bool
myAnd [] = True
myAnd (x:xs) =
if x == False
then False
else myAnd xs
-- direct recursion, using (&&)
myAnd' :: [Bool] -> Bool
myAnd' [] = True
myAnd' (x:xs) = x && myAnd' xs
-- 1
myOr :: [Bool] -> Bool
myOr [] = False
myOr (x:xs) = x || myOr xs
-- 2
myAny :: (a -> Bool) -> [a] -> Bool
myAny f xs = myOr $ map f xs
-- 3
myElem :: Eq a => a -> [a] -> Bool
myElem _ [] = False
myElem y (x:xs) = (x == y) || (myElem y xs)
-- 4
myReverse :: [a] -> [a]
myReverse [] = []
myReverse (x:xs) = (myReverse xs) ++ [x]
-- 5
squish :: [[a]] -> [a]
squish = squish' []
where squish' acc [] = acc
squish' acc (x:xs) = x ++ (squish' acc xs)
-- 6
squishMap :: (a -> [b]) -> [a] -> [b]
squishMap _ [] = []
squishMap f (x:xs) = (f x) ++ (squishMap f xs)
-- 7
squishAgain :: [[a]] -> [a]
squishAgain x = squishMap id x
-- 8
myMaximumBy :: (a -> a -> Ordering)
-> [a] -> a
myMaximumBy f (x:xs) = myMaximumBy' x xs
where myMaximumBy' m [] = m
myMaximumBy' m (y:ys)
| f y m == GT = myMaximumBy' y ys
| otherwise = myMaximumBy' m ys
-- 9
myMinimumBy :: (a -> a -> Ordering)
-> [a] -> a
myMinimumBy f (x:xs) = myMinimumBy' x xs
where myMinimumBy' m [] = m
myMinimumBy' m (y:ys)
| f y m == LT = myMinimumBy' y ys
| otherwise = myMinimumBy' m ys
-- 10
myMaximum :: (Ord a) => [a] -> a
myMaximum = myMaximumBy compare
myMinimum :: (Ord a) => [a] -> a
myMinimum = myMinimumBy compare

View File

@@ -0,0 +1,27 @@
module Exercises where
import Data.Array (filter)
import Data.Char (toLower, toUpper)
import Data.Maybe (Maybe(..))
import Data.String (fromCharArray, toCharArray, uncons)
import Prelude
-- 2
filterUppercase :: String -> String
filterUppercase s = fromCharArray $ filter (\x -> toLower x /= x) (toCharArray s)
-- 3
capitalize :: String -> String
capitalize s = maybeCapitalize $ uncons s
where maybeCapitalize Nothing = ""
maybeCapitalize (Just {head, tail}) = (fromCharArray $ [ toUpper head ]) <> tail
-- 4
capitalize' :: String -> String
capitalize' s = fromCharArray $ map toUpper $ toCharArray s
-- 5
firstLetter :: String -> Maybe Char
firstLetter = firstLetter' <<< uncons
where firstLetter' Nothing = Nothing
firstLetter' (Just {head, tail}) = Just $ toUpper head

View File

@@ -0,0 +1,8 @@
module Filtering where
import Data.Array (filter)
import Data.String (split, Pattern(..))
import Prelude
myFilter :: String -> Array String
myFilter input = filter (\x -> x /= "a" && x /= "the") (split (Pattern " ") input)

View File

@@ -0,0 +1,9 @@
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "Hello sailor!"

View File

@@ -0,0 +1,42 @@
module PoemLines where
import Data.Array ((:))
import Data.String (takeWhile, dropWhile, drop)
import Prelude
splitWith :: Char -> String -> Array String
splitWith _ "" = []
splitWith sep s = (takeWhile cond s) : (splitWith sep $ drop 1 $ dropWhile cond s)
where cond x = x /= sep
myWords :: String -> Array String
myWords = splitWith ' '
firstSen :: String
firstSen = "Tyger Tyger, burning bright\n"
secondSen :: String
secondSen = "In the forests of the night\n"
thirdSen :: String
thirdSen = "What immortal hand or eye\n"
fourthSen :: String
fourthSen = "Could frame thy fearful symmetry?"
sentences :: String
sentences = firstSen <> secondSen <> thirdSen <> fourthSen
-- putStrLn sentences -- should print
-- Tyger Tyger, burning bright
-- In the forests of the night
-- What immortal hand or eye
-- Could frame thy fearful symmetry?
myLines :: String -> Array String
myLines = splitWith '\n'
got :: Array String
got = myLines sentences
shouldEqual :: Array String
shouldEqual = [ "Tyger Tyger, burning bright"
, "In the forests of the night"
, "What immortal hand or eye"
, "Could frame thy fearful symmetry?" ]

View File

@@ -0,0 +1,25 @@
module SquareCube where
import Control.MonadZero (guard)
import Data.Array ((..))
import Data.Int (pow)
import Data.Tuple (Tuple(..))
import Prelude
mySqr :: Array Int
mySqr = do
x <- 1 .. 5
pure $ pow x 2
myCube :: Array Int
myCube = do
y <- 1 .. 5
pure $ pow y 3
mySqrCube :: Array (Tuple Int Int)
mySqrCube = do
x <- mySqr
y <- myCube
guard $ x < 50
guard $ y < 50
pure $ Tuple x y

View File

@@ -0,0 +1,27 @@
module Zipping where
import Data.Array (head, tail, (:))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
-- 1
zip :: forall a b. Array a -> Array b -> Array (Tuple a b)
zip a b = f (head a) (head b) (tail a) (tail b)
where f Nothing _ _ _ = []
f _ Nothing _ _ = []
f _ _ Nothing _ = []
f _ _ _ Nothing = []
f (Just x) (Just y) (Just xs) (Just ys) = (Tuple x y) : (f (head xs) (head ys) (tail xs) (tail ys))
-- 2
zipWith :: forall a b c. (a -> b -> c) -> Array a -> Array b -> Array c
zipWith f a b = f' (head a) (head b) (tail a) (tail b)
where f' Nothing _ _ _ = []
f' _ Nothing _ _ = []
f' _ _ Nothing _ = []
f' _ _ _ Nothing = []
f' (Just x) (Just y) (Just xs) (Just ys) = (f x y) : (f' (head xs) (head ys) (tail xs) (tail ys))
-- 3
zip' :: forall a b. Array a -> Array b -> Array (Tuple a b)
zip' = zipWith (\a b -> Tuple a b)

View File

@@ -0,0 +1,9 @@
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log "You should add some tests."

52
Haskell-book/10/Db.hs Normal file
View File

@@ -0,0 +1,52 @@
module Db 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 "Hello, world!"
, DbDate (UTCTime (fromGregorian 1921 5 1) (secondsToDiffTime 34123))
]
filterDbDate :: [DatabaseItem] -> [UTCTime]
filterDbDate xs = foldr f1 [] (filter f2 xs)
where f1 (DbDate d) acc = d : acc
f2 (DbDate d) = True
f2 _ = False
filterDbNumber :: [DatabaseItem] -> [Integer]
filterDbNumber xs = foldr f1 [] (filter f2 xs)
where f1 (DbNumber d) acc = d : acc
f2 (DbNumber d) = True
f2 _ = False
mostRecent :: [DatabaseItem] -> UTCTime
mostRecent xs = maximum (filterDbDate xs)
sumDb :: [DatabaseItem] -> Integer
sumDb xs = foldr (+) 0 (filterDbNumber xs)
avgDb :: [DatabaseItem] -> Double
avgDb xs = (fromIntegral (sumDb xs)) / (fromIntegral (length (filterDbNumber xs)))
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs
fibs20 :: [Integer]
fibs20 = take 20 (1 : scanl (+) 1 fibs)
fibs100 :: [Integer]
fibs100 = takeWhile (\x -> x < 100) fibs
fibsN :: Int -> Integer
fibsN x = fibs !! x
factorial :: [Integer]
factorial = scanl (*) 1 [1..]

View File

@@ -0,0 +1,53 @@
module Exercise where
stops :: String
stops = "pbtdkg"
vowels :: String
vowels = "aeiou"
stopVowelStop :: [(Char, Char, Char)]
stopVowelStop = filter p [(x, y, z) | x <- stops, y <- vowels, z <- stops]
where p (a, _, _) = a == 'p'
seekritFunc :: String -> Double
seekritFunc x = (/) (fromIntegral (sum (map length (words x)))) (fromIntegral (length (words x)))
myAnd :: [Bool] -> Bool
myAnd = foldr (&&) True
myOr :: [Bool] -> Bool
myOr = foldr (||) False
myAny :: (a -> Bool) -> [a] -> Bool
myAny f = myOr . map f
myElem :: Eq a => a -> [a] -> Bool
myElem x = foldr (\y z -> z || (y == x)) False
myElem' :: Eq a => a -> [a] -> Bool
myElem' needle = any (\x -> x == needle)
myReverse :: [a] -> [a]
myReverse = foldl (flip (:)) []
myMap :: (a -> b) -> [a] -> [b]
myMap f = foldr (\x y -> (f x) : y) []
myFilter :: (a -> Bool) -> [a] -> [a]
myFilter f = foldr (\x xs -> if f x then x : xs else xs) []
squish :: [[a]] -> [a]
squish = foldr (++) []
squishMap :: (a -> [b]) -> [a] -> [b]
squishMap f xs = foldr (++) [] (map f xs)
squishAgain :: [[a]] -> [a]
squishAgain = squishMap id
myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
myMaximumBy f (z:zs) = foldl (\x y -> if (f x y) == GT then x else y) z zs
myMinimumBy :: (a -> a -> Ordering) -> [a] -> a
myMinimumBy f (z:zs) = foldl (\x y -> if (f x y) == LT then x else y) z zs

30
Haskell-book/11/As.hs Normal file
View File

@@ -0,0 +1,30 @@
module As where
import Data.Char
isSubseqOf :: (Eq a) => [a] -> [a] -> Bool
isSubseqOf [] _ = True
isSubseqOf _ [] = False
isSubseqOf a@(x:xs) (y:ys)
| x == y = isSubseqOf xs ys
| otherwise = isSubseqOf a ys
capitalize :: Char -> Char
capitalize x
| (ord x) >= (ord 'a') = (chr ((ord x) - 32))
| otherwise = x
capitalizeWords :: String -> [(String, String)]
capitalizeWords text = map f (words text)
where f w@(x:xs) = (w, (capitalize x) : xs)
capitalizeWord :: String -> String
capitalizeWord (x:xs) = (capitalize x) : xs
capitalizeParagraph :: String -> String
capitalizeParagraph = it True
where it _ [] = []
it _ ('.':xs) = '.' : (it True xs)
it y (x:xs)
| (ord x) >= (ord 'a') && (ord x) < (ord 'z') && y = (capitalize x) : (it False xs)
| otherwise = x : (it y xs)

View File

@@ -0,0 +1,87 @@
module BinaryTree where
data BinaryTree a = Leaf
| Node (BinaryTree a) a (BinaryTree a)
deriving (Eq, Ord, Show)
insert' :: Ord a => a -> BinaryTree a -> BinaryTree a
insert' b Leaf = Node Leaf b Leaf
insert' b (Node left a right)
| b == a = Node left a right
| b < a = Node (insert' b left) a right
| b > a = Node left a (insert' b right)
mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left v right) =
Node (mapTree f left) (f v) (mapTree f right)
preorder :: BinaryTree a -> [a]
preorder Leaf = []
preorder (Node left v right) =
v : ((preorder left) ++ (preorder right))
inorder :: BinaryTree a -> [a]
inorder Leaf = []
inorder (Node left v right) =
(inorder left) ++ [v] ++ (inorder right)
postorder :: BinaryTree a -> [a]
postorder Leaf = []
postorder (Node left v right) =
((postorder left) ++ (postorder right)) ++ [v]
foldTree :: (a -> b -> b)
-> b
-> BinaryTree a
-> b
foldTree _ acc Leaf = acc
foldTree f acc (Node left v right) = foldTree f r left
where r = foldTree f (f v acc) right
testTree :: BinaryTree Integer
testTree =
Node (Node Leaf 1 Leaf)
2
(Node Leaf 3 Leaf)
testPreorder :: IO ()
testPreorder =
if preorder testTree == [2, 1, 3]
then putStrLn "Preorder fine!"
else putStrLn "Bad news bears."
testInorder :: IO ()
testInorder =
if inorder testTree == [1, 2, 3]
then putStrLn "Inorder fine!"
else putStrLn "Bad news bears."
testPostorder :: IO ()
testPostorder =
if postorder testTree == [1, 3, 2]
then putStrLn "Postorder fine!"
else putStrLn "postorder failed check"
main :: IO ()
main = do
testPreorder
testInorder
testPostorder
testTree' :: BinaryTree Integer
testTree' =
Node (Node Leaf 3 Leaf)
1
(Node Leaf 4 Leaf)
mapExpected =
Node (Node Leaf 4 Leaf)
2
(Node Leaf 5 Leaf)
-- acceptance test for mapTree
mapOkay =
if mapTree (+1) testTree' == mapExpected
then print "yup okay!"
else error "test failed!"

24
Haskell-book/11/Cipher.hs Normal file
View File

@@ -0,0 +1,24 @@
module Cipher where
import Data.Char
import Data.List
decode :: (Char, Int) -> Char
decode (x, y) = chr ((mod ((ord x) - 65 + y) 26) + 65)
decodeWithKey :: [Int] -> String -> String
decodeWithKey _ [] = []
decodeWithKey ys (' ':xs) = ' ' : (decodeWithKey ys xs)
decodeWithKey (y:ys) (x:xs) = (decode (x, y)) : (decodeWithKey ys xs)
vigenere :: String -> String
vigenere = decodeWithKey (cycle [0, 11, 11, 24])
caeser :: String -> String
caeser = decodeWithKey (cycle [11])
main :: IO ()
main = do
putStrLn (vigenere "MEET AT DAWN")
putStrLn (caeser "MEET AT DAWN")
return ()

11
Haskell-book/11/Garden.hs Normal file
View File

@@ -0,0 +1,11 @@
module Garden where
data FlowerType = Gardenia
| Daisy
| Rose
| Lilac
deriving Show
type Gardener = String
data Garden = Garden Gardener FlowerType deriving Show

13
Haskell-book/11/Hutton.hs Normal file
View File

@@ -0,0 +1,13 @@
module Hutton where
data Expr
= Lit Integer
| Add Expr Expr
eval :: Expr -> Integer
eval (Lit x) = x
eval (Add x y) = (eval x) + (eval y)
printExpr :: Expr -> String
printExpr (Lit x) = show x
printExpr (Add x y) = (printExpr x) ++ " + " ++ (printExpr y)

87
Haskell-book/11/Phone.hs Normal file
View File

@@ -0,0 +1,87 @@
module Phone where
import Data.Char (ord)
import Data.List (sortBy)
data DaPhone = DaPhone
convo :: [String]
convo =
[ "Wanna play 20 questions"
, "Ya"
, "U 1st haha"
, "Lol ok. Have u ever tasted alcohol"
, "Lol ya"
, "Wow ur cool haha. Ur turn"
, "Ok. Do u think I am pretty Lol"
, "Lol ya"
, "Just making sure rofl ur turn" ]
-- validButtons = "1234567890*#"
type Digit = Char
-- Valid presses: 1 and up
type Presses = Int
data Button = Button Digit String
-- assuming the default phone definition
-- 'a' -> [('2', 1)]
-- 'A' -> [('*', 1), ('2', 1)]
reverseTaps :: DaPhone -> Char -> [(Digit, Presses)]
reverseTaps _ c
| c == '.' = [('#', 1)]
| c == ',' = [('#', 2)]
| c == '#' = [('#', 3)]
| c == '+' = [('0', 1)]
| c == ' ' = [('0', 2)]
| c == '0' = [('0', 3)]
| (ord c) >= (ord 'w') = [('9', (ord c) - (ord 'w') + 1)]
| (ord c) >= (ord 't') = [('8', (ord c) - (ord 't') + 1)]
| (ord c) >= (ord 'p') = [('7', (ord c) - (ord 'p') + 1)]
| (ord c) >= (ord 'm') = [('6', (ord c) - (ord 'm') + 1)]
| (ord c) >= (ord 'j') = [('5', (ord c) - (ord 'j') + 1)]
| (ord c) >= (ord 'g') = [('4', (ord c) - (ord 'g') + 1)]
| (ord c) >= (ord 'd') = [('3', (ord c) - (ord 'd') + 1)]
| (ord c) >= (ord 'a') = [('2', (ord c) - (ord 'a') + 1)]
| (ord c) >= (ord 'W') = [('*', 1), ('9', (ord c) - (ord 'W') + 1)]
| (ord c) >= (ord 'T') = [('*', 1), ('8', (ord c) - (ord 'T') + 1)]
| (ord c) >= (ord 'P') = [('*', 1), ('7', (ord c) - (ord 'P') + 1)]
| (ord c) >= (ord 'M') = [('*', 1), ('6', (ord c) - (ord 'M') + 1)]
| (ord c) >= (ord 'J') = [('*', 1), ('5', (ord c) - (ord 'J') + 1)]
| (ord c) >= (ord 'G') = [('*', 1), ('4', (ord c) - (ord 'G') + 1)]
| (ord c) >= (ord 'D') = [('*', 1), ('3', (ord c) - (ord 'D') + 1)]
| (ord c) >= (ord 'A') = [('*', 1), ('2', (ord c) - (ord 'A') + 1)]
| c == '9' = [('9', 5)]
| c == '8' = [('8', 4)]
| c == '7' = [('7', 5)]
| c == '6' = [('6', 4)]
| c == '5' = [('5', 4)]
| c == '4' = [('4', 4)]
| c == '3' = [('3', 4)]
| c == '2' = [('2', 4)]
| c == '1' = [('2', 1)]
cellPhonesDead :: DaPhone -> String -> [(Digit, Presses)]
cellPhonesDead dp s = concat (map (reverseTaps dp) s)
fingerTaps :: [(Digit, Presses)] -> Presses
fingerTaps = foldr f 0
where f (_, p) acc = p + acc
mostPopularLetter :: String -> Char
mostPopularLetter c = fst $ head (sortBy (\(_, x1) (_, x2) -> compare x2 x1) $ foldr foldF [] c)
where foldF c [] = [(c, 1)]
foldF c ((x, n):xs)
| c == x = (x, n + 1) : xs
| otherwise = (x, n) : (foldF c xs)
coolestLtr :: [String] -> Char
coolestLtr = mostPopularLetter . concat
coolestWord :: [String] -> String
coolestWord c = fst $ head (sortBy (\(_, x1) (_, x2) -> compare x2 x1) $ foldr foldF [] (words (concat c)))
where foldF c [] = [(c, 1)]
foldF c ((x, n):xs)
| c == x = (x, n + 1) : xs
| otherwise = (x, n) : (foldF c xs)

View File

@@ -0,0 +1,40 @@
module Programmer where
data OperatingSystem = GnuPlusLinux
| OpenBSDPlusNevermindJustBSDStill
| Mac
| Windows
deriving (Eq, Show)
data ProgLang = Haskell
| Agda
| Idris
| PureScript
deriving (Eq, Show)
data Programmer = Programmer { os :: OperatingSystem
, lang :: ProgLang }
deriving (Eq, Show)
allOperatingSystems :: [OperatingSystem]
allOperatingSystems =
[ GnuPlusLinux
, OpenBSDPlusNevermindJustBSDStill
, Mac
, Windows
]
allLanguages :: [ProgLang]
allLanguages =
[ Haskell
, Agda
, Idris
, PureScript
]
allProgrammers :: [Programmer]
allProgrammers = do
o <- allOperatingSystems
l <- allLanguages
return Programmer { os = o
, lang = l }

View File

@@ -0,0 +1,16 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module TooMany where
newtype Goats = Goats Int deriving (Eq, Show, TooMany)
newtype Cows = Cows Int deriving (Eq, Show)
class TooMany a where
tooMany :: a -> Bool
instance TooMany Int where
tooMany n = n > 42
instance TooMany (Int, String) where
tooMany (n, _) = n > 42

View File

@@ -0,0 +1,40 @@
module Vehicle where
data Price = Price Integer deriving (Eq, Show)
data Size = Size Integer deriving (Eq, Show)
data Manufacturer = Mini
| Mazda
| Tata
deriving (Eq, Show)
data Airline = PapuAir
| CatapultsR'Us
| TakeYourChancesUnited
deriving (Eq, Show)
data Vehicle = Car Manufacturer Price
| Plane Airline Size
deriving (Eq, Show)
myCar = Car Mini (Price 14000)
urCar = Car Mazda (Price 20000)
clownCar = Car Tata (Price 7000)
doge = Plane PapuAir (Size 1234)
isCar :: Vehicle -> Bool
isCar (Car _ _) = True
isCar _ = False
isPlane :: Vehicle -> Bool
isPlane (Plane _ _) = True
isPlane _ = False
areCars :: [Vehicle] -> [Bool]
areCars = map isCar
getManu :: Vehicle -> Manufacturer
getManu (Car m _) = m
data Example = MakeExample Int deriving Show

1
Haskell-book/README.txt Normal file
View File

@@ -0,0 +1 @@
Half of the exercises is done in PureScript and not in Haskell.

View File

@@ -6,3 +6,7 @@ This repository contains some excercises and projects from
## Java-Kompendium. Professionell Java programmieren lernen
Von Markus Neumann.
## Haskell Programming from first principles
By Christopher Allen and Julie Moronuki.