cleaned init
This commit is contained in:
commit
ab40846aae
20
.gitignore
vendored
Normal file
20
.gitignore
vendored
Normal file
@ -0,0 +1,20 @@
|
||||
dist
|
||||
dist-*
|
||||
cabal-dev
|
||||
*.o
|
||||
*.hi
|
||||
*.chi
|
||||
*.chs.h
|
||||
*.dyn_o
|
||||
*.dyn_hi
|
||||
.hpc
|
||||
.hsenv
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
*.prof
|
||||
*.aux
|
||||
*.hp
|
||||
*.eventlog
|
||||
.stack-work/
|
||||
cabal.project.local
|
||||
*~
|
41
.travis.yml
Normal file
41
.travis.yml
Normal file
@ -0,0 +1,41 @@
|
||||
# This is the simple Travis configuration, which is intended for use
|
||||
# on applications which do not require cross-platform and
|
||||
# multiple-GHC-version support. For more information and other
|
||||
# options, see:
|
||||
#
|
||||
# https://docs.haskellstack.org/en/stable/travis_ci/
|
||||
#
|
||||
# Copy these contents into the root directory of your Github project in a file
|
||||
# named .travis.yml
|
||||
|
||||
# Use new container infrastructure to enable caching
|
||||
sudo: false
|
||||
|
||||
# Do not choose a language; we provide our own build tools.
|
||||
language: generic
|
||||
|
||||
# Caching so the next build will be fast too.
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.stack
|
||||
|
||||
# Ensure necessary system libraries are present
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- libgmp-dev
|
||||
|
||||
before_install:
|
||||
# Download and unpack the stack executable
|
||||
- mkdir -p ~/.local/bin
|
||||
- export PATH=$HOME/.local/bin:$PATH
|
||||
- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
|
||||
|
||||
install:
|
||||
# Build dependencies
|
||||
- stack --no-terminal --install-ghc test --only-dependencies
|
||||
|
||||
script:
|
||||
# Build the package, its tests, and its docs and run the tests
|
||||
- stack --no-terminal test --haddock --no-haddock-deps
|
||||
|
30
LICENSE
Normal file
30
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.
|
6
app/Aufgabe1Main.hs
Normal file
6
app/Aufgabe1Main.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Aufgabe1
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn result
|
6
app/Aufgabe2Main.hs
Normal file
6
app/Aufgabe2Main.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Aufgabe2
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn result
|
6
app/Aufgabe3Main.hs
Normal file
6
app/Aufgabe3Main.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Aufgabe3
|
||||
|
||||
main :: IO ()
|
||||
main = putStr result
|
6
app/Aufgabe4Main.hs
Normal file
6
app/Aufgabe4Main.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Aufgabe4
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn result
|
91
src/AdressSys.hs
Normal file
91
src/AdressSys.hs
Normal file
@ -0,0 +1,91 @@
|
||||
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module AdressSys where
|
||||
|
||||
import Control.Lens
|
||||
|
||||
|
||||
|
||||
|
||||
type ID = Integer
|
||||
type DB = [(ID,[Datum])]
|
||||
|
||||
newtype Age = Age Integer deriving (Show,Eq)
|
||||
newtype Name = Name String deriving (Show,Eq)
|
||||
newtype City = City String deriving (Show,Eq)
|
||||
newtype Email = Email String deriving (Show,Eq)
|
||||
newtype Phone = Phone String deriving (Show,Eq)
|
||||
newtype Street = Street String deriving (Show,Eq)
|
||||
newtype Gender = Gender String deriving (Show,Eq)
|
||||
newtype Postcode = Postcode String deriving (Show,Eq)
|
||||
|
||||
data Adress = Adress Name Street Postcode City deriving (Show,Eq)
|
||||
data Public = Public Name (Maybe Age) (Maybe Email) deriving (Show,Eq)
|
||||
data Datum = DName Name
|
||||
| DStreet Street
|
||||
| DPostcode Postcode
|
||||
| DEmail Email
|
||||
| DPhone Phone
|
||||
| DGender Gender
|
||||
| DCity City
|
||||
| DAge Age
|
||||
deriving (Show,Eq)
|
||||
|
||||
$(makePrisms ''Datum)
|
||||
|
||||
isName :: Datum -> Maybe Name
|
||||
isName = firstOf _DName
|
||||
|
||||
isStreet :: Datum -> Maybe Street
|
||||
isStreet = firstOf _DStreet
|
||||
|
||||
isPostcode :: Datum -> Maybe Postcode
|
||||
isPostcode = firstOf _DPostcode
|
||||
|
||||
isEmail :: Datum -> Maybe Email
|
||||
isEmail = firstOf _DEmail
|
||||
|
||||
isPhone :: Datum -> Maybe Phone
|
||||
isPhone = firstOf _DPhone
|
||||
|
||||
isGender :: Datum -> Maybe Gender
|
||||
isGender = firstOf _DGender
|
||||
|
||||
isAge :: Datum -> Maybe Age
|
||||
isAge = firstOf _DAge
|
||||
|
||||
isCity :: Datum -> Maybe City
|
||||
isCity = firstOf _DCity
|
||||
|
||||
|
||||
|
||||
getName :: [Datum] -> Maybe Name
|
||||
getName = firstOf (traverse._DName)
|
||||
|
||||
getStreet :: [Datum] -> Maybe Street
|
||||
getStreet = firstOf (traverse._DStreet)
|
||||
|
||||
getPostcode :: [Datum] -> Maybe Postcode
|
||||
getPostcode = firstOf (traverse._DPostcode)
|
||||
|
||||
getEmail :: [Datum] -> Maybe Email
|
||||
getEmail = firstOf (traverse._DEmail)
|
||||
|
||||
getPhone :: [Datum] -> Maybe Phone
|
||||
getPhone = firstOf (traverse._DPhone)
|
||||
|
||||
getGender :: [Datum] -> Maybe Gender
|
||||
getGender = firstOf (traverse._DGender)
|
||||
|
||||
getAge :: [Datum] -> Maybe Age
|
||||
getAge = firstOf (traverse._DAge)
|
||||
|
||||
getCity :: [Datum] -> Maybe City
|
||||
getCity = firstOf (traverse._DCity)
|
||||
|
||||
getDataFromID :: ID -> DB -> Maybe [Datum]
|
||||
getDataFromID iD = lookup iD
|
||||
|
||||
|
||||
|
129
src/Aufgabe1.hs
Normal file
129
src/Aufgabe1.hs
Normal file
@ -0,0 +1,129 @@
|
||||
-- Aufgabe 1
|
||||
-- =========
|
||||
|
||||
module Aufgabe1 where
|
||||
|
||||
import AdressSys
|
||||
|
||||
|
||||
-- Applicative style – an abstract pattern for everyday use.
|
||||
-- --------------------------
|
||||
--
|
||||
-- Wiederholung:
|
||||
-- -----------------------------------
|
||||
-- (<$>) :: (a -> b) -> f a -> f b
|
||||
-- (<*>) :: f (a -> b) -> f a -> f b
|
||||
-- (=<<) :: (a -> m b) -> m a -> m b -- (=<<) == flip (>>=)
|
||||
-- -----------------------------------
|
||||
--
|
||||
-- Aus der Vorlesung wissen Sie bereits, dass `[]` und `Maybe` `Applicative`s sind und
|
||||
-- dass `Applicative` ermöglicht, 'Funktionen im Kontext' auf Werte im Kontext anzuwenden.
|
||||
-- Außerdem haben Sie `Currying` kennen gelernt. Ein praktisches Muster, das sich hieraus
|
||||
-- ableiten lässt, ist das folgende:
|
||||
--
|
||||
-- pure f <*> x1 <*> x2 <*> .. <*> xn
|
||||
-- wobei f :: t1 -> t2 -> .. -> tn -> t'
|
||||
-- x1 :: Applicative m => m t1
|
||||
-- x2 :: Applicative m => m t2
|
||||
-- .
|
||||
-- .
|
||||
-- xn :: Applicative m => m tn
|
||||
--
|
||||
--
|
||||
-- `pure` hebt die Funktion f in den Kontext m und `<*>` wendet f nach und nach auf alle ihre
|
||||
-- im Kontext liegenden Argumente t1 bis tn an. Vor dem Hintergrund, dass jedes `Applicative`
|
||||
-- auch ein `Functor` ist, lässt sich das Muster noch etwas verkürzen:
|
||||
--
|
||||
-- pure f <*> x1 <*> x2 <*> ... <*> xn
|
||||
-- f <$> x1 <*> x2 <*> ... <*> xn
|
||||
--
|
||||
--
|
||||
-- Importiert aus dem Modul AdressSys sind die folgenden Datentypen und Funktionen, die ein
|
||||
-- ein Datenbanksystem zur Verwaltung persönlicher Daten repräsentieren:
|
||||
--
|
||||
-- type ID = Integer
|
||||
-- type DB = [(ID,[Datum])]
|
||||
--
|
||||
-- newtype Age = Age Integer
|
||||
-- newtype Name = Name String
|
||||
-- newtype City = City String
|
||||
-- newtype Email = Email String
|
||||
-- newtype Phone = Phone String
|
||||
-- newtype Street = Street String
|
||||
-- newtype Gender = Gender String
|
||||
-- newtype Postcode = Postcode String
|
||||
--
|
||||
-- data Adress = Adress Name Street PostCode City deriving (Show,Eq)
|
||||
-- data Public = Public Name (Maybe Age) (Maybe Email) deriving (Show,Eq)
|
||||
--
|
||||
-- data Datum = DName Name
|
||||
-- | DStreet Street
|
||||
-- | DPostcode Postcode
|
||||
-- | DEmail Email
|
||||
-- | DPhone Phone
|
||||
-- | DGender Gender
|
||||
-- | DCity City
|
||||
-- | DAge Age
|
||||
-- deriving (Show,Eq)
|
||||
--
|
||||
-- getName :: [Datum] -> Maybe Name
|
||||
-- getStreet :: [Datum] -> Maybe Street
|
||||
-- getPostcode :: [Datum] -> Maybe Postcode
|
||||
-- getEmail :: [Datum] -> Maybe Email
|
||||
-- getPhone :: [Datum] -> Maybe Phone
|
||||
-- getGender :: [Datum] -> Maybe Gender
|
||||
-- getAge :: [Datum] -> Maybe Age
|
||||
-- getCity :: [Datum] -> Maybe City
|
||||
-- -- suchen jeweils das erste Vorkommen aus; gehen Sie davon aus, die Datenstruktur erlaube nur einmaliges Vorkommen
|
||||
--
|
||||
-- getDataFromID :: ID -> DB -> Maybe [Datum]
|
||||
-- -- sucht die zu einer ID zugehörigen Daten aus einer Datenbank aus
|
||||
|
||||
db1 = [(1,[DAge (Age 99),DCity (City "Portland,Oregano"),DName (Name "Mona D."),DPostcode (Postcode "42317"),DStreet (Street "Intuition 6")]),(2,[DStreet (Street "Jahnplatz 5"),DName (Name "Alfred Plickateff"),DAge (Age 22),DEmail (Email "a.plickateff@hackage.com")]),(3,[DName (Name "Gerhard Zeh")]),(4,[])]
|
||||
db2 = [(2,[DAge (Age 54),DCity (City "Bielefeld"),DName (Name "Hans Joachim Meyer"),DPostcode (Postcode "33602"),DStreet (Street "Viktoriastraße 22")]),(6,[DStreet (Street "Dönerteller 1a"),DName (Name "Hannelore Hacker"),DAge (Age 76)]),(3,[DName (Name "Lisa Lista"),DEmail (Email "lisa.lista@web.de"),DAge (Age 7)]),(5,[DName (Name "Alonzo Storch"),DStreet (Street "Antenne 2"),DCity (City "Dingenskirchen"),DPostcode (Postcode "12346")])]
|
||||
-- zwei Beispieldatenbanken
|
||||
|
||||
-- Gegeben eine Liste von persönlichen Daten fassen die folgenden Funktionen `getAdressM` und
|
||||
-- `getPublicDataM` Adress- bzw. öffentliche Daten zu einem entsprechenden Wert `Adress` bzw.
|
||||
-- `Public` zusammen; falls nicht alle nötigen Informationen gefunden werden, geben sie `Nothing`
|
||||
-- zurück.
|
||||
|
||||
getAdressM :: [Datum] -> Maybe Adress
|
||||
getAdressM ds = do
|
||||
name <- getName ds
|
||||
street <- getStreet ds
|
||||
pcode <- getPostcode ds
|
||||
city <- getCity ds
|
||||
return (Adress name street pcode city)
|
||||
|
||||
getPublicM :: [Datum] -> Maybe Public
|
||||
getPublicM ds = undefined
|
||||
|
||||
|
||||
-- Implementieren Sie nun zwei Funktionen `getAdressA` und `getPublicDataA`, die das gleiche tun,
|
||||
-- im Applicative style, d.h. indem Sie das oben beschriebene Muster verwenden.
|
||||
|
||||
getAdressA :: [Datum] -> Maybe Adress
|
||||
getAdressA ds = undefined
|
||||
|
||||
getPublicA :: [Datum] -> Maybe Public
|
||||
getPublicA ds = undefined
|
||||
|
||||
|
||||
-- Definieren Sie abschließend eine Funktion `getManyAdresses` im Applicative style, die unter
|
||||
-- Verwendung von `getAdressFromID :: ID -> DB -> Maybe Adress` Adressen für eine ganze Liste
|
||||
-- von `ID`s aus einer Liste von Datenbanken `DB`s aussucht und ausgibt.
|
||||
|
||||
getAdressFromID :: ID -> DB -> Maybe Adress
|
||||
getAdressFromID iD db = getDataFromID iD db >>= getAdressM
|
||||
|
||||
getManyAdresses :: [ID] -> [DB] -> [Maybe Adress]
|
||||
getManyAdresses iDs dbs = undefined
|
||||
|
||||
|
||||
result = unlines $
|
||||
["Adressen für Nutzer 1 bis 5 (ID) aus db1 und db2: ",
|
||||
(show $ getManyAdresses [1..5] [db1,db2]),
|
||||
"Öffentliche Daten für ID 1 db1: ",
|
||||
(show $ (getDataFromID 1 db1 >>= getPublicA))]
|
||||
|
153
src/Aufgabe1.lhs
Normal file
153
src/Aufgabe1.lhs
Normal file
@ -0,0 +1,153 @@
|
||||
Aufgabe 1
|
||||
=========
|
||||
|
||||
> module Aufgabe1 where
|
||||
|
||||
> import AdressSys
|
||||
|
||||
|
||||
Applicative style – an abstract pattern for everyday use.
|
||||
--------------------------
|
||||
|
||||
Wiederholung:
|
||||
-----------------------------------
|
||||
(<$>) :: (a -> b) -> f a -> f b
|
||||
(<*>) :: f (a -> b) -> f a -> f b
|
||||
(=<<) :: (a -> m b) -> m a -> m b -- (=<<) == flip (>>=)
|
||||
-----------------------------------
|
||||
|
||||
Aus der Vorlesung wissen Sie bereits, dass `[]` und `Maybe` `Applicative`s sind und
|
||||
dass `Applicative` ermöglicht, 'Funktionen im Kontext' auf Werte im Kontext anzuwenden.
|
||||
Außerdem haben Sie `Currying` kennen gelernt. Ein praktisches Muster, das sich hieraus
|
||||
ableiten lässt, ist das folgende:
|
||||
|
||||
pure f <*> x1 <*> x2 <*> .. <*> xn
|
||||
wobei f :: t1 -> t2 -> .. -> tn -> t'
|
||||
x1 :: Applicative m => m t1
|
||||
x2 :: Applicative m => m t2
|
||||
.
|
||||
.
|
||||
xn :: Applicative m => m tn
|
||||
|
||||
|
||||
`pure` hebt die Funktion f in den Kontext m und `<*>` wendet f nach und nach auf alle ihre
|
||||
im Kontext liegenden Argumente t1 bis tn an. Vor dem Hintergrund, dass jedes `Applicative`
|
||||
auch ein `Functor` ist, lässt sich das Muster noch etwas verkürzen:
|
||||
|
||||
pure f <*> x1 <*> x2 <*> ... <*> xn
|
||||
f <$> x1 <*> x2 <*> ... <*> xn
|
||||
|
||||
|
||||
Importiert aus dem Modul AdressSys sind die folgenden Datentypen und Funktionen, die ein
|
||||
ein Datenbanksystem zur Verwaltung persönlicher Daten repräsentieren:
|
||||
|
||||
type ID = Integer
|
||||
type DB = [(ID,[Datum])]
|
||||
|
||||
newtype Age = Age Integer
|
||||
newtype Name = Name String
|
||||
newtype City = City String
|
||||
newtype Email = Email String
|
||||
newtype Phone = Phone String
|
||||
newtype Street = Street String
|
||||
newtype Gender = Gender String
|
||||
newtype Postcode = Postcode String
|
||||
|
||||
data Adress = Adress Name Street PostCode City deriving (Show,Eq)
|
||||
data Public = Public Name (Maybe Age) (Maybe Email) deriving (Show,Eq)
|
||||
|
||||
data Datum = DName Name
|
||||
| DStreet Street
|
||||
| DPostcode Postcode
|
||||
| DEmail Email
|
||||
| DPhone Phone
|
||||
| DGender Gender
|
||||
| DCity City
|
||||
| DAge Age
|
||||
deriving (Show,Eq)
|
||||
|
||||
getName :: [Datum] -> Maybe Name
|
||||
getStreet :: [Datum] -> Maybe Street
|
||||
getPostcode :: [Datum] -> Maybe Postcode
|
||||
getEmail :: [Datum] -> Maybe Email
|
||||
getPhone :: [Datum] -> Maybe Phone
|
||||
getGender :: [Datum] -> Maybe Gender
|
||||
getAge :: [Datum] -> Maybe Age
|
||||
getCity :: [Datum] -> Maybe City
|
||||
-- suchen jeweils das erste Vorkommen aus; gehen Sie davon aus, die Datenstruktur erlaube nur einmaliges Vorkommen
|
||||
|
||||
getDataFromID :: ID -> DB -> Maybe [Datum]
|
||||
-- sucht die zu einer ID zugehörigen Daten aus einer Datenbank aus
|
||||
|
||||
> db1 = [(1,[DAge (Age 99),DCity (City "Portland,Oregano"),DName (Name "Mona D."),DPostcode (Postcode "42317"),DStreet (Street "Intuition 6")]),(2,[DStreet (Street "Jahnplatz 5"),DName (Name "Alfred Plickateff"),DAge (Age 22),DEmail (Email "a.plickateff@hackage.com")]),(3,[DName (Name "Gerhard Zeh")]),(4,[])]
|
||||
> db2 = [(2,[DAge (Age 54),DCity (City "Bielefeld"),DName (Name "Hans Joachim Meyer"),DPostcode (Postcode "33602"),DStreet (Street "Viktoriastraße 22")]),(6,[DStreet (Street "Dönerteller 1a"),DName (Name "Hannelore Hacker"),DAge (Age 76)]),(3,[DName (Name "Lisa Lista"),DEmail (Email "lisa.lista@web.de"),DAge (Age 7)]),(5,[DName (Name "Alonzo Storch"),DStreet (Street "Antenne 2"),DCity (City "Dingenskirchen"),DPostcode (Postcode "12346")])]
|
||||
> -- zwei Beispieldatenbanken
|
||||
|
||||
Gegeben eine Liste von persönlichen Daten fassen die folgenden Funktionen `getAdressM` und
|
||||
`getPublicDataM` Adress- bzw. öffentliche Daten zu einem entsprechenden Wert `Adress` bzw.
|
||||
`Public` zusammen; falls nicht alle nötigen Informationen gefunden werden, geben sie `Nothing`
|
||||
zurück.
|
||||
|
||||
> getAdressM :: [Datum] -> Maybe Adress
|
||||
> getAdressM ds = do
|
||||
> name <- getName ds
|
||||
> street <- getStreet ds
|
||||
> pcode <- getPostcode ds
|
||||
> city <- getCity ds
|
||||
> return (Adress name street pcode city)
|
||||
|
||||
> getPublicM :: [Datum] -> Maybe Public
|
||||
> getPublicM ds = undefined
|
||||
|
||||
|
||||
Implementieren Sie nun zwei Funktionen `getAdressA` und `getPublicDataA`, die das gleiche tun,
|
||||
im Applicative style, d.h. indem Sie das oben beschriebene Muster verwenden.
|
||||
|
||||
> getAdressA :: [Datum] -> Maybe Adress
|
||||
> getAdressA ds = undefined
|
||||
|
||||
> getPublicA :: [Datum] -> Maybe Public
|
||||
> getPublicA ds = undefined
|
||||
|
||||
|
||||
Definieren Sie abschließend eine Funktion `getManyAdresses` im Applicative style, die unter
|
||||
Verwendung von `getAdressFromID :: ID -> DB -> Maybe Adress` Adressen für eine ganze Liste
|
||||
von `ID`s aus einer Liste von Datenbanken `DB`s aussucht und ausgibt.
|
||||
|
||||
> getAdressFromID :: ID -> DB -> Maybe Adress
|
||||
> getAdressFromID iD db = getDataFromID iD db >>= getAdressM
|
||||
|
||||
> getManyAdresses :: [ID] -> [DB] -> [Maybe Adress]
|
||||
> getManyAdresses iDs dbs = undefined
|
||||
|
||||
|
||||
> result = unlines $
|
||||
> ["Adressen für Nutzer 1 bis 5 (ID) aus db1 und db2: ",
|
||||
> (show $ getManyAdresses [1..5] [db1,db2]),
|
||||
> "Öffentliche Daten für ID 1 db1: ",
|
||||
> (show $ (getDataFromID 1 db1 >>= getPublicA))]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
163
src/Aufgabe1.md
Normal file
163
src/Aufgabe1.md
Normal file
@ -0,0 +1,163 @@
|
||||
Aufgabe 1
|
||||
=========
|
||||
|
||||
```haskell
|
||||
module Aufgabe1 where
|
||||
|
||||
import AdressSys
|
||||
```
|
||||
|
||||
Applicative style – an abstract pattern for everyday use.
|
||||
--------------------------
|
||||
|
||||
Wiederholung:
|
||||
```haskell
|
||||
(<$>) :: Functor f => (a -> b) -> f a -> f b
|
||||
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
|
||||
(=<<) :: Monad m => (a -> m b) -> m a -> m b -- (=<<) == flip (>>=)
|
||||
```
|
||||
|
||||
Aus der Vorlesung wissen Sie bereits, dass `[]` und `Maybe` `Applicative`s sind und
|
||||
dass `Applicative` ermöglicht, 'Funktionen im Kontext' auf Werte im Kontext anzuwenden.
|
||||
Außerdem haben Sie `Currying` kennen gelernt. Ein praktisches Muster, das sich hieraus
|
||||
ableiten lässt, ist das folgende:
|
||||
|
||||
```
|
||||
pure f <*> x1 <*> x2 <*> .. <*> xn
|
||||
wobei f :: t1 -> t2 -> .. -> tn -> t'
|
||||
x1 :: Applicative m => m t1
|
||||
x2 :: Applicative m => m t2
|
||||
.
|
||||
.
|
||||
xn :: Applicative m => m tn
|
||||
```
|
||||
|
||||
`pure` hebt die Funktion f in den Kontext m und `<*>` wendet f nach und nach auf alle ihre
|
||||
im Kontext liegenden Argumente t1 bis tn an. Vor dem Hintergrund, dass jedes `Applicative`
|
||||
auch ein `Functor` ist, lässt sich das Muster noch etwas verkürzen:
|
||||
|
||||
```
|
||||
pure f <*> x1 <*> x2 <*> ... <*> xn
|
||||
f <$> x1 <*> x2 <*> ... <*> xn
|
||||
```
|
||||
|
||||
Importiert aus dem Modul AdressSys sind die folgenden Datentypen und Funktionen, die ein
|
||||
ein Datenbanksystem zur Verwaltung persönlicher Daten repräsentieren:
|
||||
|
||||
```haskell
|
||||
type ID = Integer
|
||||
type DB = [(ID,[Datum])]
|
||||
|
||||
newtype Age = Age Integer
|
||||
newtype Name = Name String
|
||||
newtype City = City String
|
||||
newtype Email = Email String
|
||||
newtype Phone = Phone String
|
||||
newtype Street = Street String
|
||||
newtype Gender = Gender String
|
||||
newtype Postcode = Postcode String
|
||||
|
||||
data Adress = Adress Name Street PostCode City deriving (Show,Eq)
|
||||
data Public = Public Name (Maybe Age) (Maybe Email) deriving (Show,Eq)
|
||||
|
||||
data Datum = DName Name
|
||||
| DStreet Street
|
||||
| DPostcode Postcode
|
||||
| DEmail Email
|
||||
| DPhone Phone
|
||||
| DGender Gender
|
||||
| DCity City
|
||||
| DAge Age
|
||||
deriving (Show,Eq)
|
||||
|
||||
getName :: [Datum] -> Maybe Name
|
||||
getStreet :: [Datum] -> Maybe Street
|
||||
getPostcode :: [Datum] -> Maybe Postcode
|
||||
getEmail :: [Datum] -> Maybe Email
|
||||
getPhone :: [Datum] -> Maybe Phone
|
||||
getGender :: [Datum] -> Maybe Gender
|
||||
getAge :: [Datum] -> Maybe Age
|
||||
getCity :: [Datum] -> Maybe City
|
||||
-- suchen jeweils das erste Vorkommen aus; gehen Sie davon aus, die Datenstruktur erlaube nur einmaliges Vorkommen
|
||||
|
||||
getDataFromID :: ID -> DB -> Maybe [Datum]
|
||||
-- sucht die zu einer ID zugehörigen Daten aus einer Datenbank aus
|
||||
|
||||
db1 = [(1,[DAge (Age 99),DCity (City "Portland,Oregano"),DName (Name "Mona D."),DPostcode (Postcode "42317"),DStreet (Street "Intuition 6")]),(2,[DStreet (Street "Jahnplatz 5"),DName (Name "Alfred Plickateff"),DAge (Age 22),DEmail (Email "a.plickateff@hackage.com")]),(3,[DName (Name "Gerhard Zeh")]),(4,[])]
|
||||
db2 = [(2,[DAge (Age 54),DCity (City "Bielefeld"),DName (Name "Hans Joachim Meyer"),DPostcode (Postcode "33602"),DStreet (Street "Viktoriastraße 22")]),(6,[DStreet (Street "Dönerteller 1a"),DName (Name "Hannelore Hacker"),DAge (Age 76)]),(3,[DName (Name "Lisa Lista"),DEmail (Email "lisa.lista@web.de"),DAge (Age 7)]),(5,[DName (Name "Alonzo Storch"),DStreet (Street "Antenne 2"),DCity (City "Dingenskirchen"),DPostcode (Postcode "12346")])]
|
||||
-- zwei Beispieldatenbanken
|
||||
```
|
||||
|
||||
Gegeben eine Liste von persönlichen Daten fassen die folgenden Funktionen `getAdressM` und
|
||||
`getPublicDataM` Adress- bzw. öffentliche Daten zu einem entsprechenden Wert `Adress` bzw.
|
||||
`Public` zusammen; falls nicht alle nötigen Informationen gefunden werden, geben sie `Nothing`
|
||||
zurück.
|
||||
|
||||
```haskell
|
||||
getAdressM :: [Datum] -> Maybe Adress
|
||||
getAdressM ds = do
|
||||
name <- getName ds
|
||||
street <- getStreet ds
|
||||
pcode <- getPostcode ds
|
||||
city <- getCity ds
|
||||
return (Adress name street pcode city)
|
||||
|
||||
getPublicM :: [Datum] -> Maybe Public
|
||||
getPublicM ds = getName ds >>= \name -> return (Public name (getAge ds) (getEmail ds))
|
||||
```
|
||||
|
||||
Implementieren Sie nun zwei Funktionen `getAdressA` und `getPublicDataA`, die das gleiche tun,
|
||||
im Applicative style, d.h. indem Sie das oben beschriebene Muster verwenden.
|
||||
|
||||
```haskell
|
||||
getAdressA :: [Datum] -> Maybe Adress
|
||||
getAdressA ds = undefined
|
||||
|
||||
getPublicA :: [Datum] -> Maybe Public
|
||||
getPublicA ds = undefined
|
||||
```
|
||||
|
||||
Definieren Sie abschließend eine Funktion `getManyAdresses` im Applicative style, die unter
|
||||
Verwendung von `getAdressFromID :: ID -> DB -> Maybe Adress` Adressen für eine ganze Liste
|
||||
von `ID`s aus einer Liste von Datenbanken `DB`s aussucht und ausgibt.
|
||||
|
||||
```haskell
|
||||
getAdressFromID :: ID -> DB -> Maybe Adress
|
||||
getAdressFromID iD db = getDataFromID iD db >>= getAdressM
|
||||
|
||||
getManyAdresses :: [ID] -> [DB] -> [Maybe Adress]
|
||||
getManyAdresses iDs dbs = undefined
|
||||
```
|
||||
|
||||
|
||||
```haskell
|
||||
result = unlines $
|
||||
["Adressen für Nutzer 1 bis 5 (ID) aus db1 und db2: ",
|
||||
(show $ getManyAdresses [1..5] [db1,db2]),
|
||||
"Öffentliche Daten für ID 1 db1: ",
|
||||
(show $ (getDataFromID 1 db1 >>= getPublicA))]
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
78
src/Aufgabe2.hs
Normal file
78
src/Aufgabe2.hs
Normal file
@ -0,0 +1,78 @@
|
||||
-- Aufgabe 2
|
||||
-- =========
|
||||
|
||||
module Aufgabe2 where
|
||||
|
||||
-- In der Vorlesung haben sie bereits einige Monaden kennengelernt. In dieser
|
||||
-- Aufgabe sollen Sie das gelernte im praktischen Einsatz kennen lernen.
|
||||
|
||||
-- Bei dieser Aufgabe geht es um das Arbeiten mit einem 'Blog-System', in dem
|
||||
-- `User`, `Post`s und `Comment`s gespeichert sind. All dies ist bereits
|
||||
-- vorgegeben im Modul `BlogSys`. Für Sie relevant werden maximal folgende
|
||||
-- Informationen zu diesem System sein:
|
||||
|
||||
-- type Title = String
|
||||
-- type Content = String
|
||||
|
||||
-- getUser :: Int -> Maybe User
|
||||
|
||||
-- getPosts :: User -> [Post]
|
||||
-- getPostTitle :: Post -> Maybe Title
|
||||
-- getPostContent :: Post -> Content
|
||||
-- getComments :: Post -> [Comment]
|
||||
-- getCommentTitle :: Comment -> Maybe Title
|
||||
-- getCommentContent :: Comment -> Content
|
||||
|
||||
import BlogSys
|
||||
|
||||
-- Schreiben Sie nun die neue Funktion `headMay`, welche /eigentlich/ in der Prelude
|
||||
-- sein sollte.
|
||||
|
||||
headMay :: [a] -> Maybe a
|
||||
|
||||
headMay = undefined
|
||||
|
||||
-- Schreiben Sie nun eine Funktion, die den ersten Buchstaben des Titels des
|
||||
-- Kommentares des ersten Posts des Users mit der gegebenen id zurückgibt,
|
||||
-- falls dieser existiert
|
||||
|
||||
getFirstLetterOfFirstCommenttitleForFirstPostOfUserWithId = gflofcffpouwi
|
||||
gflofcffpouwi :: Int -> Maybe Char
|
||||
gflofcffpouwi = undefined
|
||||
|
||||
-- Wenn man sich nun nicht immer nur den ersten Eintrag zurückgeben lassen möchte,
|
||||
-- empfiehlt es sich, eine Funktion `atMay` zu definieren.
|
||||
|
||||
atMay :: [a] -> Int -> Maybe a
|
||||
|
||||
atMay = undefined
|
||||
|
||||
|
||||
-- Schreiben Sie nun die Funktionen `getNthPost` und `getNthComment`.
|
||||
|
||||
getNthPost :: Int -> User -> Maybe Post
|
||||
|
||||
getNthPost = undefined
|
||||
|
||||
|
||||
getNthComment :: Int -> Post -> Maybe Comment
|
||||
|
||||
getNthComment = undefined
|
||||
|
||||
-- Schreiben Sie nun die Funktion:
|
||||
|
||||
getNthLetterOfContentOfNthCommentOfNthPostOfUserWithId = what
|
||||
|
||||
what :: Int -> Int -> Int -> Int -> Maybe Char
|
||||
|
||||
what = undefined
|
||||
|
||||
|
||||
result = foldl foldLogic [] [ what 2 0 1 128, gflofcffpouwi 2, what 1 1 0 20
|
||||
, what 1 0 2 29, what 2 0 0 128, what 1 1 0 1063
|
||||
, what 2 0 0 188, what 2 1 2 194, what 1 0 4 94 ]
|
||||
|
||||
|
||||
foldLogic a (Just c) = a ++ [c]
|
||||
foldLogic a _ = a
|
||||
|
78
src/Aufgabe2.lhs
Normal file
78
src/Aufgabe2.lhs
Normal file
@ -0,0 +1,78 @@
|
||||
Aufgabe 2
|
||||
=========
|
||||
|
||||
> module Aufgabe2 where
|
||||
|
||||
In der Vorlesung haben sie bereits einige Monaden kennengelernt. In dieser
|
||||
Aufgabe sollen Sie das gelernte im praktischen Einsatz kennen lernen.
|
||||
|
||||
Bei dieser Aufgabe geht es um das Arbeiten mit einem 'Blog-System', in dem
|
||||
`User`, `Post`s und `Comment`s gespeichert sind. All dies ist bereits
|
||||
vorgegeben im Modul `BlogSys`. Für Sie relevant werden maximal folgende
|
||||
Informationen zu diesem System sein:
|
||||
|
||||
type Title = String
|
||||
type Content = String
|
||||
|
||||
getUser :: Int -> Maybe User
|
||||
|
||||
getPosts :: User -> [Post]
|
||||
getPostTitle :: Post -> Maybe Title
|
||||
getPostContent :: Post -> Content
|
||||
getComments :: Post -> [Comment]
|
||||
getCommentTitle :: Comment -> Maybe Title
|
||||
getCommentContent :: Comment -> Content
|
||||
|
||||
> import BlogSys
|
||||
|
||||
Schreiben Sie nun die neue Funktion `headMay`, welche /eigentlich/ in der Prelude
|
||||
sein sollte.
|
||||
|
||||
> headMay :: [a] -> Maybe a
|
||||
>
|
||||
> headMay = undefined
|
||||
|
||||
Schreiben Sie nun eine Funktion, die den ersten Buchstaben des Titels des
|
||||
Kommentares des ersten Posts des Users mit der gegebenen id zurückgibt,
|
||||
falls dieser existiert
|
||||
|
||||
> getFirstLetterOfFirstCommentForFirstPostOfUserWithId = gflofcffpouwi
|
||||
> gflofcffpouwi :: Int -> Maybe Char
|
||||
> gflofcffpouwi = undefined
|
||||
|
||||
Wenn man sich nun nicht immer nur den ersten Eintrag zurückgeben lassen möchte,
|
||||
empfiehlt es sich, eine Funktion `atMay` zu definieren.
|
||||
|
||||
> atMay :: [a] -> Int -> Maybe a
|
||||
>
|
||||
> atMay = undefined
|
||||
|
||||
|
||||
Schreiben Sie nun die Funktionen `getNthPost` und `getNthComment`.
|
||||
|
||||
> getNthPost :: Int -> User -> Maybe Post
|
||||
>
|
||||
> getNthPost = undefined
|
||||
|
||||
|
||||
> getNthComment :: Int -> Post -> Maybe Comment
|
||||
>
|
||||
> getNthComment = undefined
|
||||
|
||||
Schreiben Sie nun die Funktion:
|
||||
|
||||
> getNthLetterOfContentOfNthCommentOfNthPostOfUserWithId = what
|
||||
>
|
||||
> what :: Int -> Int -> Int -> Int -> Maybe Char
|
||||
>
|
||||
> what = undefined
|
||||
|
||||
|
||||
> result = foldl foldLogic [] [ what 2 0 1 128, gflofcffpouwi 2, what 1 1 0 20
|
||||
> , what 1 0 2 29, what 2 0 0 128, what 1 1 0 1063
|
||||
> , what 2 0 0 188, what 2 1 2 194, what 1 0 4 94 ]
|
||||
|
||||
>
|
||||
> foldLogic a (Just c) = a ++ [c]
|
||||
> foldLogic a _ = a
|
||||
|
78
src/Aufgabe2.md
Normal file
78
src/Aufgabe2.md
Normal file
@ -0,0 +1,78 @@
|
||||
Aufgabe 2
|
||||
=========
|
||||
|
||||
> module Aufgabe2 where
|
||||
|
||||
In der Vorlesung haben sie bereits einige Monaden kennengelernt. In dieser
|
||||
Aufgabe sollen Sie das gelernte im praktischen Einsatz kennen lernen.
|
||||
|
||||
Bei dieser Aufgabe geht es um das Arbeiten mit einem 'Blog-System', in dem
|
||||
`User`, `Post`s und `Comment`s gespeichert sind. All dies ist bereits
|
||||
vorgegeben im Modul `BlogSys`. Für Sie relevant werden maximal folgende
|
||||
Informationen zu diesem System sein:
|
||||
|
||||
type Title = String
|
||||
type Content = String
|
||||
|
||||
getUser :: Int -> Maybe User
|
||||
|
||||
getPosts :: User -> [Post]
|
||||
getPostTitle :: Post -> Maybe Title
|
||||
getPostContent :: Post -> Content
|
||||
getComments :: Post -> [Comment]
|
||||
getCommentTitle :: Comment -> Maybe Title
|
||||
getCommentContent :: Comment -> Content
|
||||
|
||||
> import BlogSys
|
||||
|
||||
Schreiben Sie nun die neue Funktion `headMay`, welche /eigentlich/ in der Prelude
|
||||
sein sollte.
|
||||
|
||||
> headMay :: [a] -> Maybe a
|
||||
>
|
||||
> headMay = undefined
|
||||
|
||||
Schreiben Sie nun eine Funktion, die den ersten Buchstaben des Titels des
|
||||
Kommentares des ersten Posts des Users mit der gegebenen ID zurückgibt,
|
||||
falls dieser existiert
|
||||
|
||||
> getFirstLetterOfFirstCommentForFirstPostOfUserWithId = gflofcffpouwi
|
||||
> gflofcffpouwi :: Int -> Maybe Char
|
||||
> gflofcffpouwi = undefined
|
||||
|
||||
Wenn man sich nun nicht immer nur den ersten Eintrag zurückgeben lassen möchte,
|
||||
empfiehlt es sich, eine Funktion `atMay` zu definieren.
|
||||
|
||||
> atMay :: [a] -> Int -> Maybe a
|
||||
>
|
||||
> atMay = undefined
|
||||
|
||||
|
||||
Schreiben Sie nun die Funktionen `getNthPost` und `getNthComment`.
|
||||
|
||||
> getNthPost :: Int -> User -> Maybe Post
|
||||
>
|
||||
> getNthPost = undefined
|
||||
|
||||
|
||||
> getNthComment :: Int -> Post -> Maybe Comment
|
||||
>
|
||||
> getNthComment = undefined
|
||||
|
||||
Schreiben Sie nun die Funktion:
|
||||
|
||||
> getNthLetterOfContentOfNthCommentOfNthPostOfUserWithId = what
|
||||
>
|
||||
> what :: Int -> Int -> Int -> Int -> Maybe Char
|
||||
>
|
||||
> what = undefined
|
||||
|
||||
|
||||
> result = foldl foldLogic [] [ what 2 0 1 128, gflofcffpouwi 2, what 1 1 0 20
|
||||
> , what 1 0 2 29, what 2 0 0 128, what 1 1 0 1063
|
||||
> , what 2 0 0 188, what 2 1 2 194, what 1 0 4 94 ]
|
||||
|
||||
>
|
||||
> foldLogic a (Just c) = a ++ [c]
|
||||
> foldLogic a _ = a
|
||||
|
30
src/Aufgabe3.hs
Normal file
30
src/Aufgabe3.hs
Normal file
@ -0,0 +1,30 @@
|
||||
-- Aufgabe 3
|
||||
-- =========
|
||||
|
||||
module Aufgabe3 where
|
||||
|
||||
import Data.List
|
||||
import Hui
|
||||
|
||||
-- Real world-Andwendung: List Applicative als numerisches Tool
|
||||
-- ------------------------------------------------------------
|
||||
|
||||
|
||||
-- Sie sollen Maxima einer komplizierten Funktion finden. Die Funktion erlaubt keine analytische Berechnung
|
||||
-- der Maxima. Daher sollen Sie im Intervall [-10,10] für alle Parameter x y z w approximativ Maxima suchen.
|
||||
|
||||
-- komplizierteFunktion :: Double -> Double -> Double -> Double -> Double
|
||||
|
||||
-- Definieren Sie hierfür eine Funktion, die zusätzlich zum berechneten Wert die übergebenen Parameter zurückgibt.
|
||||
|
||||
berechnungMitEingabe :: Double -> Double -> Double -> Double -> (Double,(Double,Double,Double,Double))
|
||||
berechnungMitEingabe x y z w = undefined
|
||||
|
||||
-- Definieren mithilfe von `berechnungMitEingabe` eine Funktion `nBesteEingaben`, welche die n günstigsten
|
||||
-- Eingabeparameter-Tupel zusammen mit dem möglichst maximalen Ergebnis zurückgibt.
|
||||
|
||||
nBesteEingaben :: Int -> Double -> [(Double,(Double,Double,Double,Double))]
|
||||
nBesteEingaben n d = take n $ sortOn (undefined) $ undefined
|
||||
where range = [(-10),(-(10-d))..10]
|
||||
|
||||
result = show $ nBesteEingaben 10 1
|
30
src/Aufgabe3.lhs
Normal file
30
src/Aufgabe3.lhs
Normal file
@ -0,0 +1,30 @@
|
||||
Aufgabe 3
|
||||
=========
|
||||
|
||||
> module Aufgabe3 where
|
||||
|
||||
> import Data.List
|
||||
> import Hui
|
||||
|
||||
Real world-Andwendung: List Applicative als numerisches Tool
|
||||
------------------------------------------------------------
|
||||
|
||||
|
||||
Sie sollen Maxima einer komplizierten Funktion finden. Die Funktion erlaubt keine analytische Berechnung
|
||||
der Maxima. Daher sollen Sie im Intervall [-10,10] für alle Parameter x y z w approximativ Maxima suchen.
|
||||
|
||||
komplizierteFunktion :: Double -> Double -> Double -> Double -> Double
|
||||
|
||||
Definieren Sie hierfür eine Funktion, die zusätzlich zum berechneten Wert die übergebenen Parameter zurückgibt.
|
||||
|
||||
> berechnungMitEingabe :: Double -> Double -> Double -> Double -> (Double,(Double,Double,Double,Double))
|
||||
> berechnungMitEingabe x y z w = undefined
|
||||
|
||||
Definieren mithilfe von `berechnungMitEingabe` eine Funktion `nBesteEingaben`, welche die n günstigsten
|
||||
Eingabeparameter-Tupel zusammen mit dem möglichst maximalen Ergebnis zurückgibt.
|
||||
|
||||
> nBesteEingaben :: Int -> Double -> [(Double,(Double,Double,Double,Double))]
|
||||
> nBesteEingaben n d = take n $ sortOn (undefined) $ undefined
|
||||
> where range = [(-10),(-(10-d))..10]
|
||||
|
||||
> result = show $ nBesteEingaben 10 1
|
32
src/Aufgabe3.md
Normal file
32
src/Aufgabe3.md
Normal file
@ -0,0 +1,32 @@
|
||||
Aufgabe 3
|
||||
=========
|
||||
```haskell
|
||||
module Aufgabe3 where
|
||||
|
||||
import Data.List
|
||||
import Hui
|
||||
```
|
||||
Real world-Andwendung: List Applicative als numerisches Tool
|
||||
------------------------------------------------------------
|
||||
|
||||
Sie sollen Maxima einer komplizierten Funktion finden. Die Funktion erlaubt keine analytische Berechnung
|
||||
der Maxima. Daher sollen Sie im Intervall [-10,10] für alle Parameter x y z w approximativ Maxima suchen.
|
||||
```haskell
|
||||
komplizierteFunktion :: Double -> Double -> Double -> Double -> Double
|
||||
```
|
||||
Definieren Sie hierfür eine Funktion, die zusätzlich zum berechneten Wert die übergebenen Parameter zurückgibt.
|
||||
```haskell
|
||||
berechnungMitEingabe :: Double -> Double -> Double -> Double -> (Double,(Double,Double,Double,Double))
|
||||
berechnungMitEingabe x y z w = undefined
|
||||
```
|
||||
Definieren mithilfe von `berechnungMitEingabe` eine Funktion `nBesteEingaben`, welche die n günstigsten
|
||||
Eingabeparameter-Tupel zusammen mit dem möglichst maximalen Ergebnis zurückgibt.
|
||||
```haskell
|
||||
nBesteEingaben :: Int -> Double -> [(Double,(Double,Double,Double,Double))]
|
||||
nBesteEingaben n d = take n $ sortOn (undefined) $ undefined
|
||||
where range = [(-10),(-(10-d))..10]
|
||||
```
|
||||
|
||||
```haskell
|
||||
result = show $ nBesteEingaben 10 1
|
||||
```
|
109
src/Aufgabe4.hs
Normal file
109
src/Aufgabe4.hs
Normal file
@ -0,0 +1,109 @@
|
||||
-- Aufgabe 4
|
||||
-- =========
|
||||
|
||||
module Aufgabe4 where
|
||||
|
||||
import Control.Monad
|
||||
|
||||
|
||||
-- Mighty List Monad und das Vierfarbenproblem
|
||||
-- -------------------------------------------
|
||||
|
||||
-- In Vorlesung 2 haben Sie den Vierfarbensatz kennen gelernt. Mithilfe der
|
||||
-- List Monade lassen sich in wenigen Zeilen Code alle gültigen Kombinationen
|
||||
-- von Einfärbungen finden. Reicht einem eine gültige Lösungen, so kann man
|
||||
-- getrost die gleiche Funktion verwenden und Haskells Laziness sorgt dafür,
|
||||
-- dass nur die eine nötige Lösung berechnet wird.
|
||||
|
||||
|
||||
data Farbe = Rot | Gruen | Gelb | Blau
|
||||
deriving (Show, Eq, Enum)
|
||||
|
||||
data Landname = Frankreich
|
||||
| Deutschland
|
||||
| Niederlande
|
||||
| Grossbritannien
|
||||
| Belgien
|
||||
| Polen
|
||||
| Oesterreich
|
||||
| Ungarn
|
||||
| Island
|
||||
| Schweiz
|
||||
| Luxemburg
|
||||
| Irland
|
||||
| Italien
|
||||
| Portugal
|
||||
| Spanien
|
||||
| Slowenien
|
||||
| Liechtenstein
|
||||
| Slowakei
|
||||
| Tschechien
|
||||
deriving (Show,Eq,Enum)
|
||||
|
||||
data Land = Land Landname [Landname]
|
||||
deriving (Show,Eq)
|
||||
|
||||
defaultMap = [ Land Frankreich [Spanien, Italien, Schweiz, Deutschland, Luxemburg]
|
||||
, Land Deutschland [Frankreich, Schweiz, Oesterreich, Luxemburg, Polen, Niederlande, Belgien, Tschechien]
|
||||
, Land Niederlande [Deutschland, Belgien]
|
||||
, Land Grossbritannien [Irland]
|
||||
, Land Belgien [Frankreich, Deutschland, Luxemburg]
|
||||
, Land Polen [Slowakei, Tschechien, Deutschland]
|
||||
, Land Oesterreich [Italien, Schweiz, Deutschland, Slowakei, Liechtenstein, Slowenien, Ungarn, Tschechien]
|
||||
, Land Ungarn [Oesterreich, Slowenien, Slowakei,Deutschland ]
|
||||
, Land Island [Schweiz]
|
||||
, Land Schweiz [Frankreich, Italien, Oesterreich, Deutschland]
|
||||
, Land Luxemburg [Frankreich, Deutschland]
|
||||
, Land Irland [Grossbritannien]
|
||||
, Land Italien [Frankreich, Schweiz, Oesterreich, Slowenien ]
|
||||
, Land Portugal [Spanien]
|
||||
, Land Spanien [Frankreich, Spanien]
|
||||
, Land Slowenien [Italien, Oesterreich, Ungarn ]
|
||||
, Land Liechtenstein [Schweiz, Oesterreich]
|
||||
, Land Slowakei [Oesterreich, Ungarn, Tschechien]
|
||||
, Land Tschechien [Oesterreich, Slowakei, Polen, Deutschland ]
|
||||
]
|
||||
|
||||
-- Schreiben Sie eine Funktion `gültig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool`,
|
||||
-- die überprüft, ob eine konkrete Landeinfärbung `(Farbe,Land)` vor dem
|
||||
-- Hintergrund bereits bestehender Einfärbungen `[(Farbe,Land)]` gültig ist.
|
||||
-- 'Gültig' bedeutet, dass keine angrenzenden Länder dieselbe Farbe haben.
|
||||
|
||||
gueltig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool
|
||||
gueltig (f, (Land _ ns)) xs = undefined
|
||||
|
||||
-- Exkurs: Von List comprehensions kennen Sie die Möglichkeit mit Prädikaten zu prüfen,
|
||||
-- ob ein Wert in die Liste aufgenommen werden soll oder nicht.
|
||||
|
||||
listcomp xs = [ x | x <- xs , pred x ]
|
||||
|
||||
-- Wenn Sie statt dessen do-Notation verwenden (oder `>>=`...), können Sie die Funktion
|
||||
-- `guard :: MonadPlus m => Bool -> m ()` verwenden, um Ihre Prüffunktion innerhalb eines
|
||||
-- do-Blocks unterzubringen. Der Type constraint `MondadPlus` stellt sicher, dass die
|
||||
-- entsprechende Monad-Instanz auch ein neutrales Element `mzero` kennt. Wenn die
|
||||
-- Prüffunktion von `guard` zu `False` auswertet, wird die Berechnung durch ein `mzero`
|
||||
-- unterbrochen:
|
||||
|
||||
doNotation xs = do
|
||||
x <- xs
|
||||
guard $ pred x
|
||||
return x
|
||||
|
||||
-- Vervollständigen Sie nun die folgenden, rekursiven Funktionen, welche alle gültigen
|
||||
-- Einfärbungen einer Liste von Ländern berechnet. Benutzen Sie hierfür die Ihre
|
||||
-- `gültig-`Funktion. Beide Funktionen machen das Gleiche, aber zu Übungszwecken
|
||||
-- nutzen Sie für `einfaerbenM` do-Notation und für `einfaerbenLC` List comprehension.
|
||||
|
||||
einfaerbenM :: [Land] -> [[(Farbe,Land)]]
|
||||
einfaerbenM (x:[]) = do -- alternativ: pure $ (,) <$> [Rot .. Blau] <*> [x]
|
||||
f <- [Rot .. Blau]
|
||||
return [(f,x)]
|
||||
einfaerbenM (x:xs) = undefined
|
||||
|
||||
|
||||
einfaerbenLC :: [Land] -> [[(Farbe,Land)]]
|
||||
einfaerbenLC (x:[]) = [ [(f,x)] | f <- [Rot .. Blau] ]
|
||||
einfaerbenLC (x:xs) = undefined
|
||||
|
||||
result :: String
|
||||
result = show $ head $ einfaerbenM defaultMap
|
109
src/Aufgabe4.lhs
Normal file
109
src/Aufgabe4.lhs
Normal file
@ -0,0 +1,109 @@
|
||||
Aufgabe 4
|
||||
=========
|
||||
|
||||
> module Aufgabe4 where
|
||||
|
||||
> import Control.Monad
|
||||
|
||||
|
||||
Mighty List Monad und das Vierfarbenproblem
|
||||
-------------------------------------------
|
||||
|
||||
In Vorlesung 2 haben Sie den Vierfarbensatz kennen gelernt. Mithilfe der
|
||||
List Monade lassen sich in wenigen Zeilen Code alle gültigen Kombinationen
|
||||
von Einfärbungen finden. Reicht einem eine gültige Lösungen, so kann man
|
||||
getrost die gleiche Funktion verwenden und Haskells Laziness sorgt dafür,
|
||||
dass nur die eine nötige Lösung berechnet wird.
|
||||
|
||||
|
||||
> data Farbe = Rot | Gruen | Gelb | Blau
|
||||
> deriving (Show, Eq, Enum)
|
||||
|
||||
> data Landname = Frankreich
|
||||
> | Deutschland
|
||||
> | Niederlande
|
||||
> | Grossbritannien
|
||||
> | Belgien
|
||||
> | Polen
|
||||
> | Oesterreich
|
||||
> | Ungarn
|
||||
> | Island
|
||||
> | Schweiz
|
||||
> | Luxemburg
|
||||
> | Irland
|
||||
> | Italien
|
||||
> | Portugal
|
||||
> | Spanien
|
||||
> | Slowenien
|
||||
> | Liechtenstein
|
||||
> | Slowakei
|
||||
> | Tschechien
|
||||
> deriving (Show,Eq,Enum)
|
||||
|
||||
> data Land = Land Landname [Landname]
|
||||
> deriving (Show,Eq)
|
||||
|
||||
> defaultMap = [ Land Frankreich [Spanien, Italien, Schweiz, Deutschland, Luxemburg]
|
||||
> , Land Deutschland [Frankreich, Schweiz, Oesterreich, Luxemburg, Polen, Niederlande, Belgien, Tschechien]
|
||||
> , Land Niederlande [Deutschland, Belgien]
|
||||
> , Land Grossbritannien [Irland]
|
||||
> , Land Belgien [Frankreich, Deutschland, Luxemburg]
|
||||
> , Land Polen [Slowakei, Tschechien, Deutschland]
|
||||
> , Land Oesterreich [Italien, Schweiz, Deutschland, Slowakei, Liechtenstein, Slowenien, Ungarn, Tschechien]
|
||||
> , Land Ungarn [Oesterreich, Slowenien, Slowakei,Deutschland ]
|
||||
> , Land Island [Schweiz]
|
||||
> , Land Schweiz [Frankreich, Italien, Oesterreich, Deutschland]
|
||||
> , Land Luxemburg [Frankreich, Deutschland]
|
||||
> , Land Irland [Grossbritannien]
|
||||
> , Land Italien [Frankreich, Schweiz, Oesterreich, Slowenien ]
|
||||
> , Land Portugal [Spanien]
|
||||
> , Land Spanien [Frankreich, Spanien]
|
||||
> , Land Slowenien [Italien, Oesterreich, Ungarn ]
|
||||
> , Land Liechtenstein [Schweiz, Oesterreich]
|
||||
> , Land Slowakei [Oesterreich, Ungarn, Tschechien]
|
||||
> , Land Tschechien [Oesterreich, Slowakei, Polen, Deutschland ]
|
||||
> ]
|
||||
|
||||
Schreiben Sie eine Funktion `gültig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool`,
|
||||
die überprüft, ob eine konkrete Landeinfärbung `(Farbe,Land)` vor dem
|
||||
Hintergrund bereits bestehender Einfärbungen `[(Farbe,Land)]` gültig ist.
|
||||
'Gültig' bedeutet, dass keine angrenzenden Länder dieselbe Farbe haben.
|
||||
|
||||
> gueltig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool
|
||||
> gueltig (f, (Land _ ns)) xs = undefined
|
||||
|
||||
Exkurs: Von List comprehensions kennen Sie die Möglichkeit mit Prädikaten zu prüfen,
|
||||
ob ein Wert in die Liste aufgenommen werden soll oder nicht.
|
||||
|
||||
listcomp xs = [ x | x <- xs , pred x ]
|
||||
|
||||
Wenn Sie statt dessen do-Notation verwenden (oder `>>=`...), können Sie die Funktion
|
||||
`guard :: MonadPlus m => Bool -> m ()` verwenden, um Ihre Prüffunktion innerhalb eines
|
||||
do-Blocks unterzubringen. Der Type constraint `MondadPlus` stellt sicher, dass die
|
||||
entsprechende Monad-Instanz auch ein neutrales Element `mzero` kennt. Wenn die
|
||||
Prüffunktion von `guard` zu `False` auswertet, wird die Berechnung durch ein `mzero`
|
||||
unterbrochen:
|
||||
|
||||
doNotation xs = do
|
||||
x <- xs
|
||||
guard $ pred x
|
||||
return x
|
||||
|
||||
Vervollständigen Sie nun die folgenden, rekursiven Funktionen, welche alle gültigen
|
||||
Einfärbungen einer Liste von Ländern berechnet. Benutzen Sie hierfür die Ihre
|
||||
`gültig-`Funktion. Beide Funktionen machen das gleiche, aber zu Übungszwecken
|
||||
nutzen Sie für `einfaerbenM` do-Notation und für `einfaerbenLC` List comprehension.
|
||||
|
||||
> einfaerbenM :: [Land] -> [[(Farbe,Land)]]
|
||||
> einfaerbenM (x:[]) = do -- alternativ: pure $ (,) <$> [Rot .. Blau] <*> [x]
|
||||
> f <- [Rot .. Blau]
|
||||
> return [(f,x)]
|
||||
> einfaerbenM (x:xs) = undefined
|
||||
|
||||
|
||||
> einfaerbenLC :: [Land] -> [[(Farbe,Land)]]
|
||||
> einfaerbenLC (x:[]) = [ [(f,x)] | f <- [Rot .. Blau] ]
|
||||
> einfaerbenLC (x:xs) = undefined
|
||||
|
||||
> result :: String
|
||||
> result = show $ head $ einfaerbenM defaultMap
|
115
src/Aufgabe4.md
Normal file
115
src/Aufgabe4.md
Normal file
@ -0,0 +1,115 @@
|
||||
Aufgabe 4
|
||||
=========
|
||||
```haskell
|
||||
module Aufgabe4 where
|
||||
|
||||
import Control.Monad
|
||||
```
|
||||
|
||||
Mighty List Monad und das Vierfarbenproblem
|
||||
----------------------------------
|
||||
|
||||
In Vorlesung 2 haben Sie den Vierfarbensatz kennen gelernt. Mithilfe der
|
||||
List Monade lassen sich in wenigen Zeilen Code alle gültigen Kombinationen
|
||||
von Einfärbungen finden. Reicht einem eine gültige Lösungen, so kann man
|
||||
getrost die gleiche Funktion verwenden und Haskells Laziness sorgt dafür,
|
||||
dass nur die eine nötige Lösung berechnet wird.
|
||||
|
||||
```haskell
|
||||
data Farbe = Rot | Gruen | Gelb | Blau
|
||||
deriving (Show, Eq, Enum)
|
||||
|
||||
data Landname = Frankreich
|
||||
| Deutschland
|
||||
| Niederlande
|
||||
| Grossbritannien
|
||||
| Belgien
|
||||
| Polen
|
||||
| Oesterreich
|
||||
| Ungarn
|
||||
| Island
|
||||
| Schweiz
|
||||
| Luxemburg
|
||||
| Irland
|
||||
| Italien
|
||||
| Portugal
|
||||
| Spanien
|
||||
| Slowenien
|
||||
| Liechtenstein
|
||||
| Slowakei
|
||||
| Tschechien
|
||||
deriving (Show,Eq,Enum)
|
||||
|
||||
data Land = Land Landname [Landname]
|
||||
deriving (Show,Eq)
|
||||
|
||||
defaultMap = [ Land Frankreich [Spanien, Italien, Schweiz, Deutschland, Luxemburg]
|
||||
, Land Deutschland [Frankreich, Schweiz, Oesterreich, Luxemburg, Polen, Niederlande, Belgien, Tschechien]
|
||||
, Land Niederlande [Deutschland, Belgien]
|
||||
, Land Grossbritannien [Irland]
|
||||
, Land Belgien [Frankreich, Deutschland, Luxemburg]
|
||||
, Land Polen [Slowakei, Tschechien, Deutschland]
|
||||
, Land Oesterreich [Italien, Schweiz, Deutschland, Slowakei,
|
||||
Liechtenstein, Slowenien, Ungarn, Tschechien]
|
||||
, Land Ungarn [Oesterreich, Slowenien, Slowakei,Deutschland ]
|
||||
, Land Island [Schweiz]
|
||||
, Land Schweiz [Frankreich, Italien, Oesterreich, Deutschland]
|
||||
, Land Luxemburg [Frankreich, Deutschland]
|
||||
, Land Irland [Grossbritannien]
|
||||
, Land Italien [Frankreich, Schweiz, Oesterreich, Slowenien ]
|
||||
, Land Portugal [Spanien]
|
||||
, Land Spanien [Frankreich, Spanien]
|
||||
, Land Slowenien [Italien, Oesterreich, Ungarn ]
|
||||
, Land Liechtenstein [Schweiz, Oesterreich]
|
||||
, Land Slowakei [Oesterreich, Ungarn, Tschechien]
|
||||
, Land Tschechien [Oesterreich, Slowakei, Polen, Deutschland ]
|
||||
]
|
||||
```
|
||||
|
||||
Schreiben Sie eine Funktion `gültig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool`,
|
||||
die überprüft, ob eine konkrete Landeinfärbung `(Farbe,Land)` vor dem
|
||||
Hintergrund bereits bestehender Einfärbungen `[(Farbe,Land)]` gültig ist.
|
||||
'Gültig' bedeutet, dass keine angrenzenden Länder dieselbe Farbe haben.
|
||||
|
||||
```haskell
|
||||
gueltig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool
|
||||
gueltig (f, (Land _ ns)) xs = undefined
|
||||
```
|
||||
|
||||
Exkurs: Von List comprehensions kennen Sie die Möglichkeit mit Prädikaten zu prüfen,
|
||||
ob ein Wert in die Liste aufgenommen werden soll oder nicht.
|
||||
```haskell
|
||||
listcomp xs = [ x | x <- xs , pred x ]
|
||||
```
|
||||
Wenn Sie statt dessen do-Notation verwenden (oder `>>=`...), können Sie die Funktion
|
||||
`guard :: MonadPlus m => Bool -> m ()` verwenden, um Ihre Prüffunktion innerhalb eines
|
||||
do-Blocks unterzubringen. Der Type constraint `MondadPlus` stellt sicher, dass die
|
||||
entsprechende Monad-Instanz auch ein neutrales Element `mzero` kennt. Wenn die
|
||||
Prüffunktion von `guard` zu `False` auswertet, wird die Berechnung durch ein mit `mzero`
|
||||
unterbrochen:
|
||||
```haskell
|
||||
doNotation xs = do
|
||||
x <- xs
|
||||
guard $ pred x
|
||||
return x
|
||||
```
|
||||
Vervollständigen Sie nun die folgenden, rekursiven Funktionen, welche alle gültigen
|
||||
Einfärbungen einer Liste von Ländern berechnet. Benutzen Sie hierfür die Ihre
|
||||
`gültig-`Funktion. Beide Funktionen machen das gleiche, aber zu Übungszwecken
|
||||
nutzen Sie für `einfaerbenM` do-Notation und für `einfaerbenLC` List comprehension.
|
||||
|
||||
```haskell
|
||||
einfaerbenM :: [Land] -> [[(Farbe,Land)]]
|
||||
einfaerbenM (x:[]) = do -- alternativ: pure $ (,) <$> [Rot .. Blau] <*> [x]
|
||||
f <- [Rot .. Blau]
|
||||
return [(f,x)]
|
||||
einfaerbenM (x:xs) = undefined
|
||||
|
||||
|
||||
einfaerbenLC :: [Land] -> [[(Farbe,Land)]]
|
||||
einfaerbenLC (x:[]) = [ [(f,x)] | f <- [Rot .. Blau] ]
|
||||
einfaerbenLC (x:xs) = undefined
|
||||
|
||||
result :: String
|
||||
result = show $ head $ einfaerbenM defaultMap
|
||||
```
|
59
src/BlogSys.hs
Normal file
59
src/BlogSys.hs
Normal file
@ -0,0 +1,59 @@
|
||||
module BlogSys
|
||||
( Title -- This module is meant to not export the constructors
|
||||
, Content
|
||||
, Post
|
||||
, User
|
||||
, Comment
|
||||
, getUser
|
||||
, getPosts
|
||||
, getPostTitle
|
||||
, getPostContent
|
||||
, getComments
|
||||
, getCommentTitle
|
||||
, getCommentContent
|
||||
) where
|
||||
|
||||
type Title = String
|
||||
type Content = String
|
||||
newtype Post = Post (Maybe Title, Content, [Comment])
|
||||
newtype User = User (Int, [Post])
|
||||
newtype Comment = Comment (Maybe Title, Content)
|
||||
|
||||
getUser :: Int -> Maybe User
|
||||
getUser id = let help ((u@(User (id', _))):r) | id' == id = Just u
|
||||
| null r = Nothing
|
||||
| otherwise = help r
|
||||
in help db
|
||||
|
||||
getPosts :: User -> [Post]
|
||||
getPosts (User (_,p)) = p
|
||||
|
||||
getPostTitle :: Post -> Maybe Title
|
||||
getPostTitle (Post (t,_,_)) = t
|
||||
|
||||
getPostContent :: Post -> Content
|
||||
getPostContent (Post (_,c,_)) = c
|
||||
|
||||
getComments :: Post -> [Comment]
|
||||
getComments (Post (_,_,c)) = c
|
||||
|
||||
getCommentTitle :: Comment -> Maybe Title
|
||||
getCommentTitle (Comment (t,_)) = t
|
||||
|
||||
getCommentContent :: Comment -> Content
|
||||
getCommentContent (Comment (_,c)) = c
|
||||
|
||||
|
||||
{-
|
||||
The text's below are taken from the following sites
|
||||
|
||||
http://www.cupcakeipsum.com/
|
||||
http://lorizzle.nl/
|
||||
http://slipsum.com/
|
||||
http://baconipsum.com/
|
||||
-}
|
||||
|
||||
db = [ User (1, [ Post (Just "Sweets", "Lemon drops sweet roll cupcake biscuit cookie gummi bears powder gummies sweet. Oat cake marzipan sweet. Cupcake cotton candy halvah. Jujubes chocolate ice cream dragée. Chocolate bar candy bonbon. Jujubes bonbon apple pie. Croissant chocolate pastry tiramisu. Candy dragée soufflé icing. Tiramisu ice cream powder cake biscuit gummies.", [Comment (Nothing, "Gummi bears topping apple pie marshmallow I love toffee cake icing cake. Dessert pie toffee jelly topping bonbon lemon drops toffee. Caramels ice cream wafer chocolate cake fruitcake wafer."), Comment (Just "stuff", "Icing bear claw topping I love dessert. Icing marshmallow croissant sweet cookie jelly-o lollipop. Apple pie cookie marzipan brownie powder."), Comment (Nothing, "Powder ice cream sweet. Chocolate halvah icing I love oat cake icing muffin tiramisu dessert. Brownie pie cotton candy marshmallow muffin."), Comment (Nothing, "Icing oat cake I love muffin gummi bears halvah ice cream pie. Bear claw tootsie roll jelly beans I love cotton candy wafer. Lemon drops I love I love dragée I love jelly topping cookie. Biscuit biscuit lollipop icing dragée dessert."), Comment (Nothing, "Marshmallow tart pudding toffee toffee caramels. Croissant halvah pastry carrot cake cake dragée. Muffin dragée tootsie roll marzipan cheesecake I love.")])
|
||||
, Post (Just "GangSlang" , "Lorizzle my shizz dolizzle yo mamma amet, the bizzle its fo rizzle elit. Nullizzle sapizzle velit, sizzle you son of a bizzle, suscipit shizznit, shiz vel, arcu. Tellivizzle eget tortizzle. Sed erizzle. Check it out at dolor dapibizzle mammasay mammasa mamma oo sa crackalackin shizzle my nizzle crocodizzle. Maurizzle shiznit nibh dope fo shizzle. Boom shackalack in tortizzle. Pimpin' yo mamma rhoncus funky fresh. Hizzle yo mamma habitasse platea dictumst. Mah nizzle dope. Curabitizzle tellus crunk, pretizzle eu, mattizzle izzle, eleifend vitae, nunc. Own yo' suscipizzle. Owned shizznit sizzle that's the shizzle.", [Comment (Just "Wayyhoo", "In sagittis fo shizzle mah nizzle fo rizzle, mah home g-dizzle nizzle nisi. Yo mamma rhoncizzle, arcu non malesuada facilisis, break it down nulla aliquet mah nizzle, nizzle auctizzle izzle felis fo . Suspendisse volutpizzle boofron augue. Sizzle egestas lectizzle izzle libero. Prizzle shizznit blandizzle dang. Crazy shut the shizzle up, we gonna chung sizzle amet phat tincidunt, doggy sizzle ultricizzle sem, izzle vestibulizzle black nisi sit amizzle purizzle. Funky fresh that's the shizzle mammasay mammasa mamma oo sa its fo rizzle bizzle. Phasellus lobortizzle. Nulla lectizzle dang, convallizzle shizzle my nizzle crocodizzle, aliquizzle sit amet, hizzle rizzle, check out this. Vivamizzle pot. Vestibulizzle ante ipsum break yo neck, yall yo own yo' orci luctus izzle ultricizzle posuere pizzle Ghetto; In own yo' elizzle eu check it out brizzle condimentum. Bow wow wow my shizz pizzle, you son of a bizzle vizzle, for sure da bomb, commodo izzle, nizzle. Etizzle feugizzle, tortor eget tellivizzle shizzlin dizzle, lorizzle izzle ultricizzle lorem, id break it down mi urna vitae ass."), Comment (Just "For real?", "")])])
|
||||
, User (2, [ Post (Just "No, motherfucker", "Your bones don't break, mine do. That's clear. Your cells react to bacteria and viruses differently than mine. You don't get sick, I do. That's also clear. But for some reason, you and I react the exact same way to water. We swallow it too fast, we choke. We get some in our lungs, we drown. However unreal it may seem, we are connected, you and I. We're on the same curve, just on opposite ends.", [Comment (Just "Ehhm..", "Yeah, I like animals better than people sometimes... Especially dogs. Dogs are the best. Every time you come home, they act like they haven't seen you in a year. And the good thing about dogs... is they got different dogs for different people. Like pit bulls. The dog of dogs. Pit bull can be the right man's best friend... or the wrong man's worst enemy. You going to give me a dog for a pet, give me a pit bull. Give me... Raoul. Right, Omar? Give me Raoul."), Comment (Nothing, "The path of the righteous man is beset on all sides by the iniquities of the selfish and the tyranny of evil men. Blessed is he who, in the name of charity and good will, shepherds the weak through the valley of darkness, for he is truly his brother's keeper and the finder of lost children. And I will strike down upon thee with great vengeance and furious anger those who would attempt to poison and destroy My brothers. And you will know My name is the Lord when I lay My vengeance upon thee.")])
|
||||
, Post (Just "How 2 get FAT?", "Burgdoggen bresaola doner, biltong tenderloin picanha prosciutto pork chop jowl strip steak meatloaf pork. Meatball beef ribs burgdoggen, strip steak beef porchetta ball tip doner cupim shankle jerky flank pig tri-tip bacon. Tenderloin fatback meatball hamburger, tongue beef ribs shank turkey ribeye tail cow ground round bacon. T-bone pork beef, pork loin chicken corned beef short ribs meatloaf leberkas. Bresaola burgdoggen meatball picanha venison chuck meatloaf porchetta shank ground round tail. Pork chop swine shoulder corned beef short loin meatball leberkas brisket. Pastrami sausage meatloaf capicola shankle andouille leberkas ribeye ham bacon ball tip.", [Comment (Nothing, "Meatball drumstick flank boudin salami porchetta prosciutto jowl, pork chop picanha andouille ball tip shank frankfurter. Flank pig pork loin corned beef. Pork loin alcatra cupim shank, bacon meatloaf landjaeger andouille corned beef. Shoulder drumstick ham fatback kielbasa, burgdoggen beef swine flank kevin pig pancetta rump jerky chicken."), Comment (Nothing, "Short ribs picanha chuck corned beef filet mignon bacon pork belly venison jerky beef tail. Meatloaf jowl bresaola strip steak. T-bone hamburger filet mignon sausage flank porchetta picanha sirloin jowl spare ribs venison ribeye. Shankle short loin jowl landjaeger boudin turducken picanha pork loin burgdoggen fatback. Chuck kielbasa short loin, leberkas ball tip jowl capicola ham hock shoulder."), Comment (Nothing, "Shank fatback bacon picanha, ball tip pancetta pork loin pig ham hock venison bresaola boudin. Landjaeger tenderloin cupim spare ribs bresaola shank chuck pork belly pork t-bone jowl picanha corned beef ball tip. Short ribs ball tip short loin, ham sirloin shankle flank prosciutto t-bone cupim bresaola corned beef landjaeger burgdoggen chicken. Alcatra cow short loin ground round tongue.")])])]
|
5
src/Hui.hs
Normal file
5
src/Hui.hs
Normal file
@ -0,0 +1,5 @@
|
||||
module Hui
|
||||
( komplizierteFunktion
|
||||
) where
|
||||
|
||||
komplizierteFunktion x y z w = w * exp(x*y - z)
|
6
src/Lib.hs
Normal file
6
src/Lib.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Lib
|
||||
( someFunc
|
||||
) where
|
||||
|
||||
someFunc :: IO ()
|
||||
someFunc = putStrLn "someFunc"
|
6
stack.yaml
Normal file
6
stack.yaml
Normal file
@ -0,0 +1,6 @@
|
||||
flags: {}
|
||||
extra-package-dbs: []
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps: []
|
||||
resolver: lts-8.12
|
31
test/Aufgabe1-Spec.hs
Normal file
31
test/Aufgabe1-Spec.hs
Normal file
@ -0,0 +1,31 @@
|
||||
import Aufgabe1
|
||||
import AdressSys
|
||||
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Runners.Console (defaultMain)
|
||||
import Test.HUnit
|
||||
|
||||
|
||||
{- TEST DATA -}
|
||||
|
||||
resultManyAdresses = [Just (Adress (Name "Mona D.") (Street "Intuition 6") (Postcode "42317") (City "Portland,Oregano")),Nothing,Nothing,Just (Adress (Name "Hans Joachim Meyer") (Street "Viktoriastra\223e 22") (Postcode "33602") (City "Bielefeld")),Nothing,Nothing,Nothing,Nothing,Nothing,Just (Adress (Name "Alonzo Storch") (Street "Antenne 2") (Postcode "12346") (City "Dingenskirchen"))]
|
||||
|
||||
{- TEST CASES-}
|
||||
|
||||
getAdressATest = testCase "Teste getAdressA"
|
||||
$ assertEqual "`getAdressM db` und `getAdressA db` sollten die gleichen Adressdaten raussuchen" (getDataFromID 1 db1 >>= getAdressM)
|
||||
$ getDataFromID 1 db1 >>= getAdressA
|
||||
|
||||
getPublicATest = testCase "Teste getPublicA"
|
||||
$ assertEqual "`getPublicM db` und `getPublicA db` sollten die gleichen Adressdaten raussuchen" (getDataFromID 1 db1 >>= getPublicM)
|
||||
$ getDataFromID 1 db1 >>= getPublicA
|
||||
|
||||
getManyAdressTest = testCase "Teste getAdressA"
|
||||
$ assertEqual "Das Ergebnis für `getManyAdresses [1..5] [db1,db2]` ist falsch" resultManyAdresses
|
||||
$ getManyAdresses [1..5] [db1,db2]
|
||||
|
||||
|
||||
tests = [getManyAdressTest,getPublicATest,getAdressATest]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
68
test/Aufgabe2-Spec.hs
Normal file
68
test/Aufgabe2-Spec.hs
Normal file
@ -0,0 +1,68 @@
|
||||
import Aufgabe2
|
||||
import BlogSys
|
||||
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Runners.Console (defaultMain)
|
||||
import Test.HUnit
|
||||
|
||||
|
||||
{- TEST DATA -}
|
||||
|
||||
listWithElements = [1..10]
|
||||
emptyList = []
|
||||
|
||||
{- TEST CASES-}
|
||||
|
||||
headMayTest1 = testCase "headMay leere Liste"
|
||||
$ assertEqual "testing headMay with empty list" Nothing (headMay emptyList :: Maybe Integer)
|
||||
|
||||
headMayTest2 = testCase "headMay nicht leere Liste"
|
||||
$ assertEqual "testing headMay with non-empty List" (Just 1) (headMay listWithElements :: Maybe Integer)
|
||||
|
||||
gflofcffpouwiTest1 = testCase "gflofcffpouwi Test1"
|
||||
$ assertEqual "gflofcffpouwi Test for User 1" Nothing $ gflofcffpouwi 1
|
||||
|
||||
gflofcffpouwiTest2 = testCase "gflofcffpouwi Test2"
|
||||
$ assertEqual "gflofcffpouwi Test for User 2" (Just 'E') $ gflofcffpouwi 2
|
||||
|
||||
|
||||
atMayTest1 = testCase "atMay Test 1"
|
||||
$ assertEqual "atMay Test with element in list" (Just 4) $ atMay listWithElements 3
|
||||
|
||||
|
||||
atMayTest2 = testCase "atMay Test 2"
|
||||
$ assertEqual "atMay Test with element in list" (Just 7) $ atMay listWithElements 6
|
||||
|
||||
|
||||
atMayTest3 = testCase "atMay Test 3"
|
||||
$ assertEqual "atMay Test with last element of list" (Just 10) $ atMay listWithElements 9
|
||||
|
||||
|
||||
atMayTest4 = testCase "atMay Test 4"
|
||||
$ assertEqual "atMay Test with index out of list" Nothing $ atMay listWithElements 10
|
||||
|
||||
atMayTest5 = testCase "atMay Test 5"
|
||||
$ assertEqual "atMay Test with empty list" Nothing (atMay emptyList 1 :: Maybe Integer)
|
||||
|
||||
getNthPostTest1 = testCase "getNthPost Test 1"
|
||||
$ assertEqual "getNthPost Test for User 1 Post 1" (Just $ Just "Lemon drops sweet roll cupcake biscuit cookie gummi bears powder gummies sweet. Oat cake marzipan sweet. Cupcake cotton candy halvah. Jujubes chocolate ice cream dragée. Chocolate bar candy bonbon. Jujubes bonbon apple pie. Croissant chocolate pastry tiramisu. Candy dragée soufflé icing. Tiramisu ice cream powder cake biscuit gummies.") $ (fmap.fmap) getPostContent $ getNthPost 0 <$> getUser 1
|
||||
|
||||
getNthPostTest2 = testCase "getNthPost Test 2"
|
||||
$ assertEqual "getNthPost Test for User 1 Post 2" (Just $ Just "Lorizzle my shizz dolizzle yo mamma amet, the bizzle its fo rizzle elit. Nullizzle sapizzle velit, sizzle you son of a bizzle, suscipit shizznit, shiz vel, arcu. Tellivizzle eget tortizzle. Sed erizzle. Check it out at dolor dapibizzle mammasay mammasa mamma oo sa crackalackin shizzle my nizzle crocodizzle. Maurizzle shiznit nibh dope fo shizzle. Boom shackalack in tortizzle. Pimpin' yo mamma rhoncus funky fresh. Hizzle yo mamma habitasse platea dictumst. Mah nizzle dope. Curabitizzle tellus crunk, pretizzle eu, mattizzle izzle, eleifend vitae, nunc. Own yo' suscipizzle. Owned shizznit sizzle that's the shizzle.") $ (fmap.fmap) getPostContent $ getNthPost 1 <$> getUser 1
|
||||
|
||||
getNthPostTest3 = testCase "getNthPost Test 3"
|
||||
$ assertEqual "getNthPost Test for User 2 Post 1" (Just $ Just "Your bones don't break, mine do. That's clear. Your cells react to bacteria and viruses differently than mine. You don't get sick, I do. That's also clear. But for some reason, you and I react the exact same way to water. We swallow it too fast, we choke. We get some in our lungs, we drown. However unreal it may seem, we are connected, you and I. We're on the same curve, just on opposite ends.") $ (fmap.fmap) getPostContent $ getNthPost 0 <$> getUser 2
|
||||
|
||||
getNthPostTest4 = testCase "getNthPost Test 4"
|
||||
$ assertEqual "getNthPost Test for User 2 Post 2" (Just $ Just "Burgdoggen bresaola doner, biltong tenderloin picanha prosciutto pork chop jowl strip steak meatloaf pork. Meatball beef ribs burgdoggen, strip steak beef porchetta ball tip doner cupim shankle jerky flank pig tri-tip bacon. Tenderloin fatback meatball hamburger, tongue beef ribs shank turkey ribeye tail cow ground round bacon. T-bone pork beef, pork loin chicken corned beef short ribs meatloaf leberkas. Bresaola burgdoggen meatball picanha venison chuck meatloaf porchetta shank ground round tail. Pork chop swine shoulder corned beef short loin meatball leberkas brisket. Pastrami sausage meatloaf capicola shankle andouille leberkas ribeye ham bacon ball tip.") $ (fmap.fmap) getPostContent $ getNthPost 1 <$> getUser 2
|
||||
|
||||
testResult = testCase "Test getNthLetterOfContentOfNthCommentOfNthPostOfUserWithId"
|
||||
$ assertEqual "Testing result" "wEll doné" result
|
||||
|
||||
tests = [ headMayTest1, headMayTest2, gflofcffpouwiTest1, gflofcffpouwiTest2
|
||||
, atMayTest1, atMayTest2, atMayTest3, atMayTest4, atMayTest5
|
||||
, getNthPostTest1, getNthPostTest2, getNthPostTest3, getNthPostTest4
|
||||
, testResult]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
11
test/Aufgabe3-Spec.hs
Normal file
11
test/Aufgabe3-Spec.hs
Normal file
@ -0,0 +1,11 @@
|
||||
import Aufgabe3
|
||||
import Hui
|
||||
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Runners.Console (defaultMain)
|
||||
import Test.HUnit
|
||||
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn $ "Für Aufgabe 3 liegen noch keine Tests vor"
|
16
test/Aufgabe4-Spec.hs
Normal file
16
test/Aufgabe4-Spec.hs
Normal file
@ -0,0 +1,16 @@
|
||||
import Aufgabe4
|
||||
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Runners.Console (defaultMain)
|
||||
|
||||
import Test.HUnit
|
||||
|
||||
|
||||
einfaerbenATest = testCase "Teste einfaerbenA"
|
||||
$ assertEqual "take 2 `einfaerbenM defaultMap` und take 2 `einfaerbenA defaultMap` sollten die gleichen Färbungen ausgeben" (take 2 $ einfaerbenM defaultMap)
|
||||
$ (take 2 $ einfaerbenA defaultMap)
|
||||
|
||||
tests = [einfaerbenATest]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
116
zettel3.cabal
Normal file
116
zettel3.cabal
Normal file
@ -0,0 +1,116 @@
|
||||
name: zettel3
|
||||
version: 0.1.0.0
|
||||
synopsis: First Assignment of FFPiHaskell 2017
|
||||
-- description:
|
||||
homepage: https://github.com/FFPiHaskell/zettel3-skeleton#readme
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: FFPiHaskell Tutors
|
||||
maintainer: sdressel@techfak.uni-bielefeld.de
|
||||
copyright: 2017 FFPiHaskell Tutors
|
||||
category: cli
|
||||
build-type: Simple
|
||||
extra-source-files: README.md
|
||||
cabal-version: >=1.10
|
||||
|
||||
|
||||
-- library for all things common in all exercises/not neccessary for students
|
||||
-- to solve assignments
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: Lib
|
||||
, Aufgabe1
|
||||
, Aufgabe2
|
||||
, Aufgabe3
|
||||
, Aufgabe4
|
||||
, BlogSys
|
||||
, AdressSys
|
||||
, Hui
|
||||
build-depends: base >= 4.7 && < 5
|
||||
, IfElse
|
||||
, lens
|
||||
default-language: Haskell2010
|
||||
|
||||
executable aufgabe1
|
||||
hs-source-dirs: app
|
||||
main-is: Aufgabe1Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, zettel3
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite aufgabe1-tests
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Aufgabe1-Spec.hs
|
||||
build-depends: base
|
||||
, zettel3
|
||||
, test-framework
|
||||
, test-framework-hunit
|
||||
, HUnit
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
||||
executable aufgabe2
|
||||
hs-source-dirs: app
|
||||
main-is: Aufgabe2Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, zettel3
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite aufgabe2-tests
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Aufgabe2-Spec.hs
|
||||
build-depends: base
|
||||
, zettel3
|
||||
, test-framework
|
||||
, test-framework-hunit
|
||||
, HUnit
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
||||
executable aufgabe3
|
||||
hs-source-dirs: app
|
||||
main-is: Aufgabe3Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, zettel3
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite aufgabe3-tests
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Aufgabe3-Spec.hs
|
||||
build-depends: base
|
||||
, zettel3
|
||||
, test-framework
|
||||
, test-framework-hunit
|
||||
, HUnit
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
||||
executable aufgabe4
|
||||
hs-source-dirs: app
|
||||
main-is: Aufgabe4Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, zettel3
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite aufgabe4-tests
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Aufgabe4-Spec.hs
|
||||
build-depends: base
|
||||
, zettel3
|
||||
, test-framework
|
||||
, test-framework-hunit
|
||||
, HUnit
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/FFPiHaskell/zettel3-skeleton
|
Loading…
Reference in New Issue
Block a user