initial commit

src/Aufgabe4.md

+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
+

src/ERPSys.hs

+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)
+

src/Lib.hs

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

src/List.hs

+{-# 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
+

stack.yaml

+# 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

test/Aufgabe1-Spec.hs

+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

test/Aufgabe2-Spec.hs

+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

test/Aufgabe3-Spec.hs

+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

test/Aufgabe4-Spec.hs

+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."

zettel1.cabal

+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