Added solutions for Blatt 3 & Blatt 5

To compile and run Blatt5 just do a "stack build" and either

stack exec Blatt5-static

or

stack exec Blatt5-animated

Übungen/Blatt5-solution/Blatt5-solution.cabal

@@ -0,0 +1,64 @@
+name:                Blatt5-solution
+version:             0.1.0.0
+synopsis:            Solution for Sheet 5 of our course FFPiHaskell (2016)
+description:         Please see README.md
+homepage:            https://github.com/ffpihaskell/Vorlesung2016
+license:             BSD3
+license-file:        LICENSE
+author:              Stefan Dresselhaus
+maintainer:          sdressel@techfak.uni-bielefeld.de
+copyright:           2016 Stefan Dresselhaus
+category:            GUI
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Parser
+                     , GUI
+                     , Types
+  build-depends:       base >= 4.7 && < 5
+                     , attoparsec
+                     , bytestring
+                     , gloss
+                     , time
+                     , array
+  default-language:    Haskell2010
+
+executable Blatt5-static
+  hs-source-dirs:      app
+  main-is:             Main-Static.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , Blatt5-solution
+                     , gloss
+                     , bytestring
+                     , array
+                     , time
+  default-language:    Haskell2010
+
+executable Blatt5-animated
+  hs-source-dirs:      app
+  main-is:             Main-Animated.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , Blatt5-solution
+                     , gloss
+                     , bytestring
+                     , array
+                     , time
+  default-language:    Haskell2010
+
+test-suite Blatt5-solution-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , Blatt5-solution
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/ffpihaskell/Vorlesung2016

Übungen/Blatt5-solution/LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2016
+
+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.

Übungen/Blatt5-solution/Setup.hs

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

Übungen/Blatt5-solution/app/Main-Animated.hs

@@ -0,0 +1,30 @@
+module Main where
+
+import Parser
+import GUI
+import Types
+import Data.ByteString as BS
+import Data.Array
+import Data.Time
+import Data.Word
+import Graphics.Gloss
+import Data.Monoid
+
+datafile :: String
+datafile = "time_ip.csv"
+
+mainAnimate :: IO ()
+mainAnimate = do
+        df <- BS.readFile datafile
+        let pd = ipBuckets <$> parseData df
+        case pd of
+          Right pd' -> animate (InWindow "Animation" (800,600) (100,200)) white (animateGrid 240 200 pd')
+          Left err  -> print $ "parsing Error:" <> err
+
+main :: IO ()
+main = mainAnimate
+
+ipBuckets :: [Data] -> Array (Word8,Word8,Int) Int
+ipBuckets d = accumArray (+) 0 ((0,0,0),(15,15,23)) (f <$> d)
+        where
+                f (Data _ (TimeOfDay h m _) (IPv4 a _ _ _)) = ((a `div` 16, a `mod` 16, h), 1)

Übungen/Blatt5-solution/app/Main-Static.hs

@@ -0,0 +1,30 @@
+module Main where
+
+import Parser
+import GUI
+import Types
+import Data.ByteString as BS
+import Data.Array
+import Data.Time
+import Data.Word
+import Graphics.Gloss
+import Data.Monoid
+
+datafile :: String
+datafile = "time_ip.csv"
+
+mainStatic :: IO ()
+mainStatic = do
+        df <- BS.readFile datafile
+        let pd = hourBuckets <$> parseData df
+        case pd of
+          Right pd' -> display (InWindow "Bar Chart" (800,600) (100,200)) white (drawBar 240 200 pd')
+          Left err  -> print $ "parsing Error:" <> err
+
+main :: IO ()
+main = mainStatic
+
+hourBuckets :: [Data] -> Array Int Int
+hourBuckets d = accumArray (+) 0 (0,23) (f <$> d)
+        where
+                f (Data _ (TimeOfDay h _ _) _) = (h,1)

Übungen/Blatt5-solution/src/GUI.hs

@@ -0,0 +1,46 @@
+module GUI where
+
+import Data.Array
+import Graphics.Gloss
+import Data.Word
+
+type Height = Int
+type Width = Int
+
+drawBar :: Width -> Height -> Array Int Int -> Picture
+drawBar w h a = Pictures $ draw <$> [0..num]
+        where
+                num = u - l
+                (l, u) = bounds a
+                w' :: Float
+                w' = fromIntegral w / fromIntegral num
+                h' :: Float
+                h' = fromIntegral h / fromIntegral (maximum $ elems a)
+                draw :: Int -> Picture
+                draw i = Translate (w'*i') 0 $ -- translate the whole bar
+                         Pictures [ Color blue $ Polygon [(0,0), (0, h''), (w', h''), (w', 0)] -- draw bar
+                                  , Translate 0 (-10) $ Scale 0.05 0.05 $ Text (show i) -- draw caption
+                                  ]
+                        where
+                                i' = fromIntegral i
+                                h'' = fromIntegral (a!i) * h'
+
+animateGrid :: Width -> Height -> Array (Word8, Word8, Int) Int -> Float -> Picture
+animateGrid w h d f = Pictures $ draw <$> [0..l1] <*> [0..l2]
+        where
+              (_, (l1, l2, t)) = bounds d
+              maxVal :: Float
+              maxVal = fromIntegral . maximum . elems $ d
+              draw :: Word8 -> Word8 -> Picture
+              draw x y = Translate (w'*fromIntegral x) (h'*fromIntegral y) $
+                         Pictures [ Color (mixColors val (maxVal-val) red green) $ rectangleSolid w' h'
+                                  , Scale 0.05 0.05 . Text . show . round $ val
+                                  ]
+                                          where
+                                                  val = fromIntegral $ d!(x,y,f')
+              w' :: Float
+              w' = fromIntegral w / fromIntegral l1
+              h' :: Float
+              h' = fromIntegral h / fromIntegral l2
+              f' = floor f `mod` t
+

Übungen/Blatt5-solution/src/Parser.hs

@@ -0,0 +1,69 @@
+module Parser 
+        
+       (parseData)
+
+       where
+
+import qualified Data.ByteString as BS
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString.Char8 (isHorizontalSpace, char, endOfLine, decimal, digit)
+import Data.Time (Day(..), TimeOfDay(..), makeTimeOfDayValid, fromGregorianValid)
+import Types
+
+
+parseData :: BS.ByteString -> Either String [Data]
+parseData = parseOnly parserData
+
+parserData :: Parser [Data]
+parserData = many' parseDatapoint
+
+
+parseDatapoint :: Parser Data
+parseDatapoint = do
+        skipWhile isHorizontalSpace
+        d <- parseDay
+        char 'T'
+        t <- parseTime
+        char 'Z'
+        skipWhile isHorizontalSpace
+        char ','
+        skipWhile isHorizontalSpace
+        ip <- parseIP
+        skipWhile isHorizontalSpace
+        endOfLine
+        return $ Data d t ip
+
+parseDay :: Parser Day
+parseDay = do
+        y <- count 4 digit
+        char '-'
+        m <- count 2 digit
+        char '-'
+        d <- count 2 digit
+        case fromGregorianValid (read y) (read m) (read d) of
+          (Just d) -> return d
+          Nothing  -> fail "Incorrect Date"
+
+
+parseTime :: Parser TimeOfDay
+parseTime = do
+        h <- count 2 digit
+        char ':'
+        m <- count 2 digit
+        char ':'
+        s <- count 2 digit
+        case makeTimeOfDayValid (read h) (read m) (read s) of
+          (Just t) -> return t
+          Nothing  -> fail "Incorrect Time"
+
+parseIP :: Parser IPv4
+parseIP = do
+        a <- decimal
+        char '.'
+        b <- decimal
+        char '.'
+        c <- decimal
+        char '.'
+        d <- decimal
+        return $ IPv4 a b c d
+

Übungen/Blatt5-solution/src/Types.hs

@@ -0,0 +1,14 @@
+module Types where
+
+import Data.Word
+import Data.Time
+
+data Data = Data
+          { date :: Day
+          , time :: TimeOfDay
+          , ip   :: IPv4
+          }
+          deriving (Show, Eq)
+
+data IPv4 = IPv4 Word8 Word8 Word8 Word8
+        deriving (Show, Eq)

Übungen/Blatt5-solution/stack.yaml

@@ -0,0 +1,34 @@
+# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
+
+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
+resolver: lts-5.13
+
+# Local packages, usually specified by relative directory name
+packages:
+- '.'
+
+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
+extra-deps: [ gloss-1.10.1.1
+            , gloss-rendering-1.10.1.1
+            ]
+
+# 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.0.0
+
+# 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]

Übungen/Blatt5-solution/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"