From 9ba103928d545d9e47a7892b71e72902dd81a6ca Mon Sep 17 00:00:00 2001 From: Yannick Gottschalk Date: Mon, 24 Apr 2017 00:15:00 +0200 Subject: [PATCH] initial commit --- .gitignore | 20 +++++++ .travis.yml | 41 ++++++++++++++ LICENSE | 30 +++++++++++ README.md | 111 ++++++++++++++++++++++++++++++++++++++ Setup.hs | 2 + app/Aufgabe1Main.hs | 6 +++ app/Aufgabe2Main.hs | 6 +++ app/Aufgabe3Main.hs | 6 +++ app/Aufgabe4Main.hs | 6 +++ src/Aufgabe1.hs | 48 +++++++++++++++++ src/Aufgabe1.lhs | 47 ++++++++++++++++ src/Aufgabe1.md | 47 ++++++++++++++++ src/Aufgabe2.hs | 41 ++++++++++++++ src/Aufgabe2.lhs | 41 ++++++++++++++ src/Aufgabe2.md | 41 ++++++++++++++ src/Aufgabe3.hs | 31 +++++++++++ src/Aufgabe3.lhs | 31 +++++++++++ src/Aufgabe3.md | 31 +++++++++++ src/Aufgabe4.hs | 40 ++++++++++++++ src/Aufgabe4.lhs | 40 ++++++++++++++ src/Aufgabe4.md | 40 ++++++++++++++ src/ERPSys.hs | 18 +++++++ src/Lib.hs | 14 +++++ src/List.hs | 123 ++++++++++++++++++++++++++++++++++++++++++ stack.yaml | 66 +++++++++++++++++++++++ test/Aufgabe1-Spec.hs | 17 ++++++ test/Aufgabe2-Spec.hs | 40 ++++++++++++++ test/Aufgabe3-Spec.hs | 63 ++++++++++++++++++++++ test/Aufgabe4-Spec.hs | 4 ++ zettel1.cabal | 111 ++++++++++++++++++++++++++++++++++++++ 30 files changed, 1162 insertions(+) create mode 100644 .gitignore create mode 100644 .travis.yml create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 app/Aufgabe1Main.hs create mode 100644 app/Aufgabe2Main.hs create mode 100644 app/Aufgabe3Main.hs create mode 100644 app/Aufgabe4Main.hs create mode 100644 src/Aufgabe1.hs create mode 100644 src/Aufgabe1.lhs create mode 100644 src/Aufgabe1.md create mode 100644 src/Aufgabe2.hs create mode 100644 src/Aufgabe2.lhs create mode 100644 src/Aufgabe2.md create mode 100644 src/Aufgabe3.hs create mode 100644 src/Aufgabe3.lhs create mode 100644 src/Aufgabe3.md create mode 100644 src/Aufgabe4.hs create mode 100644 src/Aufgabe4.lhs create mode 100644 src/Aufgabe4.md create mode 100644 src/ERPSys.hs create mode 100644 src/Lib.hs create mode 100644 src/List.hs create mode 100644 stack.yaml create mode 100644 test/Aufgabe1-Spec.hs create mode 100644 test/Aufgabe2-Spec.hs create mode 100644 test/Aufgabe3-Spec.hs create mode 100644 test/Aufgabe4-Spec.hs create mode 100644 zettel1.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0383d89 --- /dev/null +++ b/.gitignore @@ -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 +*~ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..5ccfeba --- /dev/null +++ b/.travis.yml @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..6a042c2 --- /dev/null +++ b/LICENSE @@ -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. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..2205788 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Aufgabe1Main.hs b/app/Aufgabe1Main.hs new file mode 100644 index 0000000..a8a86ee --- /dev/null +++ b/app/Aufgabe1Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Aufgabe1 + +main :: IO () +main = putStrLn result diff --git a/app/Aufgabe2Main.hs b/app/Aufgabe2Main.hs new file mode 100644 index 0000000..19eac74 --- /dev/null +++ b/app/Aufgabe2Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Aufgabe2 + +main :: IO () +main = putStrLn result diff --git a/app/Aufgabe3Main.hs b/app/Aufgabe3Main.hs new file mode 100644 index 0000000..8c9213d --- /dev/null +++ b/app/Aufgabe3Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Aufgabe3 + +main :: IO () +main = putStrLn result diff --git a/app/Aufgabe4Main.hs b/app/Aufgabe4Main.hs new file mode 100644 index 0000000..637355c --- /dev/null +++ b/app/Aufgabe4Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Aufgabe4 + +main :: IO () +main = putStrLn result diff --git a/src/Aufgabe1.hs b/src/Aufgabe1.hs new file mode 100644 index 0000000..c1a10b9 --- /dev/null +++ b/src/Aufgabe1.hs @@ -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!" diff --git a/src/Aufgabe1.lhs b/src/Aufgabe1.lhs new file mode 100644 index 0000000..a4fc00d --- /dev/null +++ b/src/Aufgabe1.lhs @@ -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!" diff --git a/src/Aufgabe1.md b/src/Aufgabe1.md new file mode 100644 index 0000000..a4fc00d --- /dev/null +++ b/src/Aufgabe1.md @@ -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!" diff --git a/src/Aufgabe2.hs b/src/Aufgabe2.hs new file mode 100644 index 0000000..03b5d42 --- /dev/null +++ b/src/Aufgabe2.hs @@ -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 diff --git a/src/Aufgabe2.lhs b/src/Aufgabe2.lhs new file mode 100644 index 0000000..b2031ee --- /dev/null +++ b/src/Aufgabe2.lhs @@ -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 diff --git a/src/Aufgabe2.md b/src/Aufgabe2.md new file mode 100644 index 0000000..b2031ee --- /dev/null +++ b/src/Aufgabe2.md @@ -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 diff --git a/src/Aufgabe3.hs b/src/Aufgabe3.hs new file mode 100644 index 0000000..9deed12 --- /dev/null +++ b/src/Aufgabe3.hs @@ -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 diff --git a/src/Aufgabe3.lhs b/src/Aufgabe3.lhs new file mode 100644 index 0000000..e44fc01 --- /dev/null +++ b/src/Aufgabe3.lhs @@ -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 diff --git a/src/Aufgabe3.md b/src/Aufgabe3.md new file mode 100644 index 0000000..e44fc01 --- /dev/null +++ b/src/Aufgabe3.md @@ -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 diff --git a/src/Aufgabe4.hs b/src/Aufgabe4.hs new file mode 100644 index 0000000..d609f72 --- /dev/null +++ b/src/Aufgabe4.hs @@ -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 + diff --git a/src/Aufgabe4.lhs b/src/Aufgabe4.lhs new file mode 100644 index 0000000..6dca6a0 --- /dev/null +++ b/src/Aufgabe4.lhs @@ -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 + diff --git a/src/Aufgabe4.md b/src/Aufgabe4.md new file mode 100644 index 0000000..6dca6a0 --- /dev/null +++ b/src/Aufgabe4.md @@ -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 + diff --git a/src/ERPSys.hs b/src/ERPSys.hs new file mode 100644 index 0000000..c545f5f --- /dev/null +++ b/src/ERPSys.hs @@ -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) + diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 index 0000000..409bafd --- /dev/null +++ b/src/Lib.hs @@ -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 diff --git a/src/List.hs b/src/List.hs new file mode 100644 index 0000000..cd7c198 --- /dev/null +++ b/src/List.hs @@ -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 + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..95c95bc --- /dev/null +++ b/stack.yaml @@ -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 diff --git a/test/Aufgabe1-Spec.hs b/test/Aufgabe1-Spec.hs new file mode 100644 index 0000000..0cb135f --- /dev/null +++ b/test/Aufgabe1-Spec.hs @@ -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 diff --git a/test/Aufgabe2-Spec.hs b/test/Aufgabe2-Spec.hs new file mode 100644 index 0000000..e929807 --- /dev/null +++ b/test/Aufgabe2-Spec.hs @@ -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 diff --git a/test/Aufgabe3-Spec.hs b/test/Aufgabe3-Spec.hs new file mode 100644 index 0000000..9f0de65 --- /dev/null +++ b/test/Aufgabe3-Spec.hs @@ -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 diff --git a/test/Aufgabe4-Spec.hs b/test/Aufgabe4-Spec.hs new file mode 100644 index 0000000..87ffee4 --- /dev/null +++ b/test/Aufgabe4-Spec.hs @@ -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." diff --git a/zettel1.cabal b/zettel1.cabal new file mode 100644 index 0000000..c88a166 --- /dev/null +++ b/zettel1.cabal @@ -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