FFPiH/uebung2017_1
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

initial commit

Browse Source
This commit is contained in:
Yannick Gottschalk
2017-04-24 00:15:00 +02:00
commit 9ba103928d
30 changed files with 1162 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
.gitignore vendored Normal file
View 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
View 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
View 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.

111
README.md Normal file
View File

@@ -0,0 +1,111 @@
Übungszettel 1
==============
Dieses Repository dient der ersten Übung des Moduls Fortgeschrittene
Funktionale Programmierung in Haskell.
Wir werden sowohl in den Übungen als auch für das Projekt als Compiler den GHC
in Version >= 8 verwenden, sowie stack, ein Progamm zur Unterstützung der
Entwicklung von Haskell programmen.
Als Editor/IDE empfehlen wir nvim.
Stack
-----
> $ stack update
Neuste Paketliste laden
> $ stack setup
Läd den GHC und andere erforderliche Daten für ein das Projekt herunter
> $ stack build
Baut das Projekt
> $ stack test
Testet das Projekt
> $ stack haddock
Generiert die Dokumentation für das Projekt
> $ stack ghci
Compiliert das Projekt und startet den GHCi im Kontext des Projekts
> $ stack help
Try for yourself
Github
------
Wir verwenden Github statt des Lernraums/LernraumPLUS/moodle/etc.
Das bedeutet, dass ihr einen Github-Account braucht.
Das hoch und runterladen der Aufgaben / des Projekts erfolgt mit dem
Kommandozeilenprogramm git.
> $ git clone https://github.com/[..]
Klont ein git-repository in eine extra dafür neu angelegten Ordner
> $ git status
Zeigt den status des git-repository's an. Das bedeutet, welche Dateien
verändert wurden, und welche Änderungen "staged for commit" sind, dh. in einen
Commit einfließen werden.
> $ git commit -am "Aufgabe1.hs solved"
Speichert alle Änderungen, die staged sind, in einen Commit mit einer Commit
Message.
> $ git push
Pusht die Commits, dh. läd alle Commits hoch.
Falls ihr nvim verwendet, gibt es im Editor einige Plugins für eine direkte
Integration von git.
Github Classroom
----------------
Ihr werdet einen Link an eure Github-Mail erhalten, welcher euch Zugang einem
Assignment gibt.
Jedes Assignment erstellt ein neues privaten Repository mit der
Aufgabenstellung, in welches ihr eure Lösungen hochladen könnt.
Travis CI
---------
Travis ist ein continuous integration service. Immer wenn ihr eine Aufgabe
bearbeitet habt und diese auf Github pusht, läd Travis diesen push in eine
virtuelle Maschiene und baut und testet die neue Version.
Das bedeutet folgendes:
- Ihr bekommt direkt Feedback zu euren Lösungen
- Wir bekommen eine Mail wenn ein Build fehlschlägt/fehlerfrei durchläuft
- Ihr habt ein Konsolen-Log, in dem Ihr einezelne Zeilen makieren könnt und
anschließend den Link an uns weiterleiten könnt um genaue Erklärungen
bzw. Lösungshilfen zu Fehlern zu bekommen
Mit anderen Worten, ihr müsst nicht im Tutorium sitzen um effizient mit euren
Tutoren zu kommunizieren

2
Setup.hs Normal file
View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

6
app/Aufgabe1Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main where
import Aufgabe1
main :: IO ()
main = putStrLn result

6
app/Aufgabe2Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main where
import Aufgabe2
main :: IO ()
main = putStrLn result

6
app/Aufgabe3Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main where
import Aufgabe3
main :: IO ()
main = putStrLn result

6
app/Aufgabe4Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main where
import Aufgabe4
main :: IO ()
main = putStrLn result

48
src/Aufgabe1.hs Normal file
View File

@@ -0,0 +1,48 @@
{-
Aufgabe 1
=========
-}
module Aufgabe1 where
{- Gegeben ist der Datentyp Pred a, der eine Prüffunktion (Prädikat) repräsentiert,
die einen Wert vom Typ a zu einem Wert vom Typ Bool auswertet.
Beachten Sie, dass mit dem Wertekonstruktor Pred bereits eine Funktion
Pred :: (a -> Bool) -> Pred a
gegeben ist, mit der Sie ein Prädikat "einpacken" können.
-}
newtype Pred a = Pred (a -> Bool)
{- Schreiben Sie eine Funktion unPred, die das Prädikat "auspackt".
-}
unPred :: Pred a -> (a -> Bool)
unPred = undefined
{- Da Haskell-Funktionen grundsätzlich “gecurried” sind, bzw. der (->)-Operator
rechtsassoziativ ist, können Sie die Klammern hinten in der Signatur auch weglassen
und erhalten unPred :: Pred a -> a -> Bool, was man zugleich als “wende Pred a an,
wenn du ein a bekommst” lesen kann.
-}
{- Definieren Sie nun eine Funktion isVowel, die prüft, ob ein Buchstabe ein Vokal ist.
-}
isVowel :: Pred Char
isVowel = undefined
{-
Schreiben Sie eine Funktion filterVowels, die alle Vorkommen von Vokalen aus
einem String entfernt. Verwenden Sie hierfür das Prädikat isVowel.
-}
filterVowels :: String -> String
filterVowels = undefined
result :: String
result = filterVowels "Hello World!"

47
src/Aufgabe1.lhs Normal file
View File

@@ -0,0 +1,47 @@
Aufgabe 1
=========
> module Aufgabe1 where
Gegeben ist der Datentyp Pred a, der eine Prüffunktion (Prädikat) repräsentiert,
die einen Wert vom Typ a zu einem Wert vom Typ Bool auswertet.
Beachten Sie, dass mit dem Wertekonstruktor Pred bereits eine Funktion
Pred :: (a -> Bool) -> Pred a
gegeben ist, mit der Sie ein Prädikat "einpacken" können.
> newtype Pred a = Pred (a -> Bool)
Schreiben Sie eine Funktion unPred, die das Prädikat "auspackt".
> unPred :: Pred a -> (a -> Bool)
>
> unPred = undefined
Da Haskell-Funktionen grundsätzlich “gecurried” sind, bzw. der (->)-Operator
rechtsassoziativ ist, können Sie die Klammern hinten in der Signatur auch weglassen
und erhalten unPred :: Pred a -> a -> Bool, was man zugleich als “wende Pred a an,
wenn du ein a bekommst” lesen kann.
Definieren Sie nun eine Funktion isVowel, die prüft, ob ein Buchstabe ein Vokal ist.
> isVowel :: Pred Char
>
> isVowel = undefined
Schreiben Sie eine Funktion filterVowels, die alle Vorkommen von Vokalen aus
einem String entfernt. Verwenden Sie hierfür das Prädikat isVowel.
> filterVowels :: String -> String
>
> filterVowels = undefined
> result :: String
>
> result = filterVowels "Hello World!"

47
src/Aufgabe1.md Normal file
View File

@@ -0,0 +1,47 @@
Aufgabe 1
=========
> module Aufgabe1 where
Gegeben ist der Datentyp Pred a, der eine Prüffunktion (Prädikat) repräsentiert,
die einen Wert vom Typ a zu einem Wert vom Typ Bool auswertet.
Beachten Sie, dass mit dem Wertekonstruktor Pred bereits eine Funktion
Pred :: (a -> Bool) -> Pred a
gegeben ist, mit der Sie ein Prädikat "einpacken" können.
> newtype Pred a = Pred (a -> Bool)
Schreiben Sie eine Funktion unPred, die das Prädikat "auspackt".
> unPred :: Pred a -> (a -> Bool)
>
> unPred = undefined
Da Haskell-Funktionen grundsätzlich “gecurried” sind, bzw. der (->)-Operator
rechtsassoziativ ist, können Sie die Klammern hinten in der Signatur auch weglassen
und erhalten unPred :: Pred a -> a -> Bool, was man zugleich als “wende Pred a an,
wenn du ein a bekommst” lesen kann.
Definieren Sie nun eine Funktion isVowel, die prüft, ob ein Buchstabe ein Vokal ist.
> isVowel :: Pred Char
>
> isVowel = undefined
Schreiben Sie eine Funktion filterVowels, die alle Vorkommen von Vokalen aus
einem String entfernt. Verwenden Sie hierfür das Prädikat isVowel.
> filterVowels :: String -> String
>
> filterVowels = undefined
> result :: String
>
> result = filterVowels "Hello World!"

41
src/Aufgabe2.hs Normal file
View File

@@ -0,0 +1,41 @@
-- Aufgabe 2
-- =========
module Aufgabe2 where
-- Machen Sie sich mit den Modulen
import List
import ERPSys
-- vertraut. Einige der Aufgaben diese Woche basieren auf diesen.
-- Hypothetisches Real-World Problem
-- ---------------------------------
-- Gegeben ein bereits existierendes Warenwirtschaftssystem (Modul ERPSys), welches
-- auf einer eigenen Datenstruktur (Modul List) basiert.
-- Die Firma, in der Sie arbeiten wird beauftragt, ein neues Kassensystem zu
-- entwickeln. Sie werden beauftragt, den Scanalogorithmus der Kasse zu
-- programmieren.
-- Dazu ist zuerst die Funktion `findArticle` zu entwickeln, die gegeben einen
-- Barcode und eine Produktliste einen Artikel findet.
findArticle :: (Eq a) => a -> ProductList a b c -> Maybe (Article a b c)
findArticle = undefined
productCatalog :: ProductList Int String Float
productCatalog = insert (Article 1 "Apfel" 1)
$ insert (Article 2 "Birne" 0.5)
$ insert (Article 3 "Banane" 1.5)
$ insert (Article 4 "Tomate" 0.75)
ListEnd
result = show $ findArticle 2 productCatalog

41
src/Aufgabe2.lhs Normal file
View File

@@ -0,0 +1,41 @@
Aufgabe 2
=========
> module Aufgabe2 where
Machen Sie sich mit den Modulen
> import List
>
> import ERPSys
vertraut. Einige der Aufgaben diese Woche basieren auf diesen.
Hypothetisches Real-World Problem
---------------------------------
Gegeben ein bereits existierendes Warenwirtschaftssystem (Modul `ERPSys`), welches
auf einer eigenen Datenstruktur (Modul `List`) basiert.
Die Firma, in der Sie arbeiten wird beauftragt, ein neues Kassensystem zu
entwickeln. Sie werden beauftragt, eine Teil des Scanalogorithmuses der Kasse zu
programmieren.
Dazu ist zuerst die Funktion `findArticle` zu entwickeln, die gegeben einen
Barcode und eine Produktliste einen Artikel findet.
> findArticle :: (Eq a) => a -> ProductList a b c -> Maybe (Article a b c)
>
> findArticle = undefined
> productCatalog :: ProductList Int String Float
> productCatalog = insert (Article 1 "Apfel" 1)
> $ insert (Article 2 "Birne" 0.5)
> $ insert (Article 3 "Banane" 1.5)
> $ insert (Article 4 "Tomate" 0.75)
> ListEnd
> result = show $ findArticle 2 productCatalog

41
src/Aufgabe2.md Normal file
View File

@@ -0,0 +1,41 @@
Aufgabe 2
=========
> module Aufgabe2 where
Machen Sie sich mit den Modulen
> import List
>
> import ERPSys
vertraut. Einige der Aufgaben diese Woche basieren auf diesen.
Hypothetisches Real-World Problem
---------------------------------
Gegeben ein bereits existierendes Warenwirtschaftssystem (Modul `ERPSys`), welches
auf einer eigenen Datenstruktur (Modul `List`) basiert.
Die Firma, in der Sie arbeiten wird beauftragt, ein neues Kassensystem zu
entwickeln. Sie werden beauftragt, eine Teil des Scanalogorithmuses der Kasse zu
programmieren.
Dazu ist zuerst die Funktion `findArticle` zu entwickeln, die gegeben einen
Barcode und eine Produktliste einen Artikel findet.
> findArticle :: (Eq a) => a -> ProductList a b c -> Maybe (Article a b c)
>
> findArticle = undefined
> productCatalog :: ProductList Int String Float
> productCatalog = insert (Article 1 "Apfel" 1)
> $ insert (Article 2 "Birne" 0.5)
> $ insert (Article 3 "Banane" 1.5)
> $ insert (Article 4 "Tomate" 0.75)
> ListEnd
> result = show $ findArticle 2 productCatalog

31
src/Aufgabe3.hs Normal file
View File

@@ -0,0 +1,31 @@
-- Aufgabe 3
-- =========
module Aufgabe3 where
import Data.Maybe (fromMaybe)
import List
import ERPSys
import Aufgabe2
-- Die Funktion scan soll, aus einer `ProductList` (2. Argument) anhand eines
-- Barcodes (1. Argument) einen Artikel finden und diesen dann in eine
-- Scannerliste einfügen. Wurde kein Artiekl gefunden gibt `scan` `Nothing` zurück.
-- Um die eigentliche Funktion `scan` zu implementieren, empfiehlt es sich, zuerst
-- eine Instanz `Eq` für `Article` zu definieren.
-- Diese sollte anhand des Barcodes die Gleichheit eines Artikels bestimmen.
scan :: (Eq a) => a -> ProductList a b c -> ScannerList a b c -> Maybe (ScannerList a b c)
scan = undefined
instance (Eq a) => Eq (Article a b c) where
(==) = undefined
result = show $ scan 1 productCatalog
$ fromMaybe AmountListEnd $ scan 2 productCatalog
$ fromMaybe AmountListEnd $ scan 1 productCatalog AmountListEnd

31
src/Aufgabe3.lhs Normal file
View File

@@ -0,0 +1,31 @@
Aufgabe 3
=========
> module Aufgabe3 where
>
> import Data.Maybe (fromMaybe)
>
> import List
>
> import ERPSys
>
> import Aufgabe2
Die Funktion scan soll, aus einer `ProductList` (2. Argument) anhand eines
Barcodes (1. Argument) einen Artikel finden und diesen dann in eine
Scannerliste einfügen. Wurde kein Artiekl gefunden gibt `scan` `Nothing` zurück.
Um die eigentliche Funktion `scan` zu implementieren, empfiehlt es sich, zuerst
eine Instanz `Eq` für `Article` zu definieren.
Diese sollte anhand des Barcodes die Gleichheit eines Artikels bestimmen.
> scan :: (Eq a) => a -> ProductList a b c -> ScannerList a b c -> Maybe (ScannerList a b c)
>
> scan = undefined
> instance (Eq a) => Eq (Article a b c) where
>
> (==) = undefined
> result = show $ scan 1 productCatalog
> $ fromMaybe AmountListEnd $ scan 2 productCatalog
> $ fromMaybe AmountListEnd $ scan 1 productCatalog AmountListEnd

31
src/Aufgabe3.md Normal file
View File

@@ -0,0 +1,31 @@
Aufgabe 3
=========
> module Aufgabe3 where
>
> import Data.Maybe (fromMaybe)
>
> import List
>
> import ERPSys
>
> import Aufgabe2
Die Funktion scan soll, aus einer `ProductList` (2. Argument) anhand eines
Barcodes (1. Argument) einen Artikel finden und diesen dann in eine
Scannerliste einfügen. Wurde kein Artiekl gefunden gibt `scan` `Nothing` zurück.
Um die eigentliche Funktion `scan` zu implementieren, empfiehlt es sich, zuerst
eine Instanz `Eq` für `Article` zu definieren.
Diese sollte anhand des Barcodes die Gleichheit eines Artikels bestimmen.
> scan :: (Eq a) => a -> ProductList a b c -> ScannerList a b c -> Maybe (ScannerList a b c)
>
> scan = undefined
> instance (Eq a) => Eq (Article a b c) where
>
> (==) = undefined
> result = show $ scan 1 productCatalog
> $ fromMaybe AmountListEnd $ scan 2 productCatalog
> $ fromMaybe AmountListEnd $ scan 1 productCatalog AmountListEnd

40
src/Aufgabe4.hs Normal file
View File

@@ -0,0 +1,40 @@
-- Aufgabe 4
-- =========
module Aufgabe4 where
import Lib
import Aufgabe2
import Aufgabe3
import Data.Maybe (fromMaybe)
-- Nun da eine `ScannerList` erstellt werden kann, wird eine Funktion, die einen Kassenbon erstellen kann, benötigt.
-- Dieser sollte angemessen formatiert sein.
-- Die Funktion `generateBill` soll diese Aufgabe übernehmen.
type Bill = String
generateBill :: (Show a, Show b, Show c) => ScannerList a b c -> Bill
generateBill = undefined
result = generateBill scannerList
-- Ein paar Hilfsfunktionen zum generieren einer `ScannerList` asu einer Liste
-- von Barcodes. /Glücklicherweise/ hat diese bereits ein Kollege von Ihnen entwickelt!
-- (Mit anderen Worten: Sie brauchen die unten stehenden Funktionen weder
-- anpassen, noch verstehen und auch nicht benutzen, nochmal Glück gehabt ;D )
scannerList :: ScannerList Int String Float
scannerList = fromMaybe AmountListEnd $ scanList [1,3,1,2,1,3]
scanList :: [Int] -> Maybe (ScannerList Int String Float)
scanList l = let help :: [Int] -> Maybe (ScannerList Int String Float) -> Maybe (ScannerList Int String Float)
help = flip $ foldl (\sl a -> sl >>= preparedScan a)
in help l $ Just AmountListEnd
preparedScan :: Int -> ScannerList Int String Float -> Maybe (ScannerList Int String Float)
preparedScan = flip scan productCatalog

40
src/Aufgabe4.lhs Normal file
View File

@@ -0,0 +1,40 @@
Aufgabe 4
=========
> module Aufgabe4 where
>
> import Lib
> import Aufgabe2
> import Aufgabe3
> import Data.Maybe (fromMaybe)
Nun da eine `ScannerList` erstellt werden kann, wird eine Funktion, die einen Kassenbon erstellen kann, benötigt.
Dieser sollte /angemessen/ formatiert sein.
Die Funktion `generateBill` soll diese Aufgabe übernehmen.
> type Bill = String
>
> generateBill :: (Show a, Show b, Show c) => ScannerList a b c -> Bill
>
> generateBill = undefined
> result = generateBill scannerList
Ein paar Hilfsfunktionen zum generieren einer `ScannerList` asu einer Liste
von Barcodes. /Glücklicherweise/ hat diese bereits ein Kollege von Ihnen entwickelt!
(Mit anderen Worten: Sie brauchen die unten stehenden Funktionen weder
anpassen, noch verstehen und auch nicht benutzen, nochmal Glück gehabt ;D )
> scannerList :: ScannerList Int String Float
> scannerList = fromMaybe AmountListEnd $ scanList [1,3,1,2,1,3]
> scanList :: [Int] -> Maybe (ScannerList Int String Float)
> scanList l = let help :: [Int] -> Maybe (ScannerList Int String Float) -> Maybe (ScannerList Int String Float)
> help = flip $ foldl (\sl a -> sl >>= preparedScan a)
> in help l $ Just AmountListEnd
> preparedScan :: Int -> ScannerList Int String Float -> Maybe (ScannerList Int String Float)
>
> preparedScan = flip scan productCatalog

40
src/Aufgabe4.md Normal file
View File

@@ -0,0 +1,40 @@
Aufgabe 4
=========
> module Aufgabe4 where
>
> import Lib
> import Aufgabe2
> import Aufgabe3
> import Data.Maybe (fromMaybe)
Nun da eine `ScannerList` erstellt werden kann, wird eine Funktion, die einen Kassenbon erstellen kann, benötigt.
Dieser sollte /angemessen/ formatiert sein.
Die Funktion `generateBill` soll diese Aufgabe übernehmen.
> type Bill = String
>
> generateBill :: (Show a, Show b, Show c) => ScannerList a b c -> Bill
>
> generateBill = undefined
> result = generateBill scannerList
Ein paar Hilfsfunktionen zum generieren einer `ScannerList` asu einer Liste
von Barcodes. /Glücklicherweise/ hat diese bereits ein Kollege von Ihnen entwickelt!
(Mit anderen Worten: Sie brauchen die unten stehenden Funktionen weder
anpassen, noch verstehen und auch nicht benutzen, nochmal Glück gehabt ;D )
> scannerList :: ScannerList Int String Float
> scannerList = fromMaybe AmountListEnd $ scanList [1,3,1,2,1,3]
> scanList :: [Int] -> Maybe (ScannerList Int String Float)
> scanList l = let help :: [Int] -> Maybe (ScannerList Int String Float) -> Maybe (ScannerList Int String Float)
> help = flip $ foldl (\sl a -> sl >>= preparedScan a)
> in help l $ Just AmountListEnd
> preparedScan :: Int -> ScannerList Int String Float -> Maybe (ScannerList Int String Float)
>
> preparedScan = flip scan productCatalog

18
src/ERPSys.hs Normal file
View File

@@ -0,0 +1,18 @@
module ERPSys
( ProductList
, ScannerList
, Article(Article)
) where
import List
type ProductList a b c = List (Article a b c) -- ^ List with Articles
type ScannerList a b c = AmountList Int (Article a b c) -- ^ AmountList with Articles
-- | generic Article isomorph to (,,)
data Article a b c = Article
{ _barcode :: a
, _name :: b
, _price :: c
} deriving (Show)

14
src/Lib.hs Normal file
View File

@@ -0,0 +1,14 @@
module Lib
( ProductList
, ScannerList
, Article(Article)
, List(ListEnd, Element)
, AmountList(AmountAndElement, AmountListEnd)
, Filter
, Searchable(..)
, Consumable(..)
, Insertable(..)
) where
import List
import ERPSys

123
src/List.hs Normal file
View File

@@ -0,0 +1,123 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module List
( List(ListEnd, Element)
, AmountList(AmountAndElement, AmountListEnd)
, Filter
, Searchable(..)
, Consumable(..)
, Insertable(..)
-- , amountOf
) where
import Control.Lens
import Data.Maybe (fromMaybe)
-- | isomorph to []
data List a = ListEnd | Element
{ _el :: a
, _remaining :: (List a)
} deriving (Show)
makeLenses (''List)
-- | counting list
data AmountList a b = AmountListEnd | AmountAndElement
{ _amount :: a
, _el' :: b
, _remaining' :: (AmountList a b)
} deriving (Show)
makeLenses (''AmountList)
type Filter a = a -> Bool
instance Monoid (List a) where
mempty = ListEnd
mappend ListEnd = id
mappend a = mappend $ a ^. remaining
instance Monoid (AmountList a b) where
mempty = AmountListEnd
mappend AmountListEnd = id
mappend a = mappend $ a ^. remaining'
instance Eq a => Eq (List a) where
ListEnd == ListEnd = True
a == b = a^?el == b^?el
&& a^?remaining == b^?remaining
instance (Eq a, Eq b) => Eq (AmountList a b) where
AmountListEnd == AmountListEnd = True
a == b = a^?amount == b^?amount
&& a^?el' == b^?el'
&& a^?remaining' == b^?remaining'
-- | find with return type determined by the structure b a
class Searchable a b c | b a -> c where
findFirst :: Filter a -> b a -> Maybe c
-- | find first a in list matching the filter
instance Searchable a List a where
findFirst :: Filter a -> List a -> Maybe a
findFirst filter list = list^?el>>=(\el_-> if filter el_
then Just el_
else findFirst filter $ list^.remaining)
-- | find first a in list matching the filter returning (amount, element)
instance Searchable a (AmountList b) (b, a) where
findFirst :: Filter a -> AmountList b a -> Maybe (b, a)
findFirst filter list = list^?el' >>= \el_ -> if filter el_
then Just (list^?!amount, el_)
else list^?remaining' >>= findFirst filter
class Consumable b a c | b a -> c where
consume :: (c -> d -> d) -> d -> b a -> d
-- ^ special form of a fold determined by structure b a
-- | isomorph to a foldr
instance Consumable List a a where
consume :: (a -> d -> d) -> d -> List a -> d
consume _ a ListEnd = a
consume f s (Element a as) = f a $ consume f s as
-- | foldr over (element, amount)
instance Consumable (AmountList b) a (a, b) where
consume :: ((a, b) -> e -> e) -> e -> AmountList b a -> e
consume _ a AmountListEnd = a
consume f s (AmountAndElement b a as) = f (a,b) $ consume f s as
{--instance {-# OVERLAPPABLE #-} Consumable (AmountList b) a a where
consume :: (a -> e -> e) -> e -> AmountList b a -> e
consume _ a AmountListEnd = a
consume f s (AmountAndElement b a as) = f a $ consume f s as --}
class Insertable a b where
insert :: a -> b a -> b a
-- ^ insert a to structure b
-- | RTFC!
instance Insertable a List where
insert :: a -> List a -> List a
insert = Element
-- | insert with amount count += 1
instance (Eq a, Num b) => Insertable a (AmountList b) where
insert :: a -> AmountList b a -> AmountList b a
insert a AmountListEnd = AmountAndElement 1 a AmountListEnd
insert a b = case b^?el' & _Just %~ (==a) of
Just True -> b & amount +~ 1
_ -> b & remaining' %~ (insert a)
-- | get amount of a in list. returning mempty if not found
amountOf :: (Eq a, Monoid b) => a -> AmountList b a -> b
amountOf a b = fromMaybe mempty $ b ^. to (findFirst (==a)) & _Just %~ fst
--b ^. to findFirst (==a) %~ _1 ^. to fromMaybe mempty
-- (Just (c,_)) -> c
-- Nothing -> mempty

66
stack.yaml Normal file
View File

@@ -0,0 +1,66 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# http://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
# name: custom-snapshot
# location: "./custom-snapshot.yaml"
resolver: lts-8.12
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
# git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# extra-dep: true
# subdirs:
# - auto-update
# - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- '.'
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps: []
# Override default flag values for local packages and extra-deps
flags: {}
# Extra package databases containing global packages
extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.1"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

17
test/Aufgabe1-Spec.hs Normal file
View File

@@ -0,0 +1,17 @@
import Aufgabe1
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Runners.Console (defaultMain)
import Test.HUnit
test1 = testCase "filter funktioniert" $ assertEqual "Vowel filter" "Hll Wrld!" result
testSentence2 = "Is really EVERY VowEL of this uSEleSS SentencE remOved?"
testResult2 = "s rlly VRY VwL f ths SlSS Sntnc rmvd?"
test2 = testCase "filter test" $ assertEqual testSentence2 testResult2 $ filterVowels testSentence2
tests = [test1, test2]
main :: IO ()
main = defaultMain tests

40
test/Aufgabe2-Spec.hs Normal file
View File

@@ -0,0 +1,40 @@
import Aufgabe2
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Runners.Console (defaultMain)
import Test.HUnit
import Lib
instance (Eq a, Eq b, Eq c) => Eq (Article a b c) where
(Article a b c) == (Article a' b' c') = a == a' && b == b' && c == c'
data TestProd = Tp1 | Tp2 | Tp3 deriving (Eq, Show)
emptyProductList :: ProductList Int () ()
emptyProductList = ListEnd
productList :: ProductList Int TestProd ()
productList = insert (Article 0 Tp1 ())
$ insert (Article 1 Tp2 ())
$ insert (Article 2 Tp3 ())
$ ListEnd
emptyFind = testCase "Suche in leerer Liste"
$ assertEqual "empty list search" Nothing
$ findArticle 0 emptyProductList
findNone = testCase "Suche nach nicht vorhandenem"
$ assertEqual "find nothing" Nothing
$ findArticle 3 productList
findSome = testCase "Suche nach vorhandenem"
$ assertEqual "find some" (Just $ Article 0 Tp1 ())
$ findArticle 0 productList
tests = [emptyFind, findNone, findSome]
main :: IO ()
main = defaultMain tests

63
test/Aufgabe3-Spec.hs Normal file
View File

@@ -0,0 +1,63 @@
import Aufgabe3
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Runners.Console (defaultMain)
import Test.HUnit
import Lib
data TestProd = Tp1 | Tp2 | Tp3 deriving (Eq, Show)
productList :: ProductList Int TestProd ()
productList = insert (Article 0 Tp1 ())
$ insert (Article 1 Tp2 ())
$ insert (Article 2 Tp3 ())
$ ListEnd
emptyScannerList :: ScannerList Int TestProd ()
emptyScannerList = AmountListEnd
scannerList1 = scan 0 productList emptyScannerList
scannerList2 = scan 9 productList emptyScannerList
scannerList3 = scannerList1 >>= scan 0 productList
scannerList4 = scannerList3 >>= scan 1 productList
scannerList5 = scannerList4 >>= scan 2 productList
scannerList6 = scannerList5 >>= scan 9 productList
scannerList7 = scannerList5 >>= scan 1 productList
scannerList8 = scannerList7 >>= scan 0 productList
scannerList9 = scannerList8 >>= scan 9 productList
scan1 = testCase "Scan, existing product, list size: 0 "
$ assertEqual "scan 1" (Just $ AmountAndElement 1 (Article 0 Tp1 ()) AmountListEnd) scannerList1
scan2 = testCase "Scan, not existing product, list size: 0 "
$ assertEqual "scan 2" Nothing scannerList2
scan3 = testCase "Scan, existing product, list size: 1, product already in list"
$ assertEqual "scan 3" (Just $ AmountAndElement 2 (Article 0 Tp1 ()) AmountListEnd) scannerList3
scan4 = testCase "Scan, existing product, list size: 1, product not in list "
$ assertEqual "scan 4" (Just $ AmountAndElement 2 (Article 0 Tp1 ()) $ AmountAndElement 1 (Article 1 Tp2 ()) AmountListEnd) scannerList4
scan5 = testCase "Scan, existing product, list size: 2, product not in list "
$ assertEqual "scan 5" (Just $ AmountAndElement 2 (Article 0 Tp1 ()) $ AmountAndElement 1 (Article 1 Tp2 ()) $ AmountAndElement 1 (Article 2 Tp3 ()) AmountListEnd) scannerList5
scan6 = testCase "Scan, not existing product, list size: 2 "
$ assertEqual "scan 3" Nothing scannerList6
scan7 = testCase "Scan, existing product, list size: 3, product in list "
$ assertEqual "scan 7" (Just $ AmountAndElement 2 (Article 0 Tp1 ()) $ AmountAndElement 2 (Article 1 Tp2 ()) $ AmountAndElement 1 (Article 2 Tp3 ()) AmountListEnd) scannerList7
scan8 = testCase "Scan, existing product, list size: 3, product in list "
$ assertEqual "scan 8" (Just $ AmountAndElement 3 (Article 0 Tp1 ()) $ AmountAndElement 2 (Article 1 Tp2 ()) $ AmountAndElement 1 (Article 2 Tp3 ()) AmountListEnd) scannerList8
scan9 = testCase "Scan, not existing product, list size: 3 "
$ assertEqual "scan 9" Nothing scannerList9
tests = [scan1, scan2, scan3, scan4, scan5, scan6, scan7, scan8, scan9]
main :: IO ()
main = defaultMain tests

4
test/Aufgabe4-Spec.hs Normal file
View File

@@ -0,0 +1,4 @@
main :: IO ()
main = do
putStrLn "Da Ihnen in dieser Aufgabe Platz für Kreativität eingeräumt wurde,"
putStrLn "lässt sich Ihre Lösung leider nicht automatisiert überprüfen."

111
zettel1.cabal Normal file
View File

@@ -0,0 +1,111 @@
name: zettel1
version: 0.1.0.0
synopsis: First Assignment of FFPiHaskell 2017
-- description:
homepage: https://github.com/FFPiHaskell/zettel1-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
, List
, ERPSys
build-depends: base >= 4.7 && < 5
, lens
default-language: Haskell2010
executable aufgabe1
hs-source-dirs: app
main-is: Aufgabe1Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, zettel1
default-language: Haskell2010
test-suite aufgabe1-tests
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Aufgabe1-Spec.hs
build-depends: base
, zettel1
, 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
, zettel1
default-language: Haskell2010
test-suite aufgabe2-tests
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Aufgabe2-Spec.hs
build-depends: base
, zettel1
, 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
, zettel1
default-language: Haskell2010
test-suite aufgabe3-tests
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Aufgabe3-Spec.hs
build-depends: base
, zettel1
, 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
, zettel1
default-language: Haskell2010
test-suite aufgabe4-tests
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Aufgabe4-Spec.hs
build-depends: base
, zettel1
ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
source-repository head
type: git
location: https://github.com/FFPiHaskell/zettel1-skeleton