Seite 5: Nachtrag

module MyCounter
    ( 
          countdown
        , resetCounter
        , decCounter
        , decT
        , loopCounter
        , inc
        , MAX(..)
        , MIN(..)
        , MyCounter(..)
        , Countdown(..)
        , Steps (..)
    ) where

import Control.Monad (forever)
import Control.Concurrent.STM
import Control.Concurrent.MVar
import Control.Concurrent (forkIO,threadDelay)
import System.Exit as Exit
import qualified Lib as Lib

data MyCounter = MyCounter Int deriving (Eq)
data Countdown = C MyCounter | M MAX | N MIN deriving (Show,Eq)
data MAX = MAX Int deriving (Eq)
data MIN = MIN Int deriving (Eq)
data Steps = Steps Int deriving (Eq)
type CounterVar = TVar Countdown

instance Show MyCounter where
    show (MyCounter i) = show i
    
instance Show MAX where
    show (MAX i) = show i   
    
instance Show MIN where
    show (MIN i) = show i  
    
instance Show Steps where
    show (Steps i) = "Modified counter " ++ (show i) ++ " times."    

myCompare :: Countdown -> Countdown -> Ordering
(M (MAX n)) `myCompare` (C (MyCounter i))
    | n == i = EQ
    | n < i = LT
    | otherwise = GT
(N (MIN n)) `myCompare` (C (MyCounter i))
    | n == i = EQ
    | n < i = LT
    | otherwise = GT
c@(C (MyCounter _)) `myCompare` m@(N (MIN _)) = m `myCompare` c
c@(C (MyCounter _)) `myCompare` m@(M (MAX _)) = m `myCompare` c

resetCounter :: Countdown -> IO CounterVar
resetCounter (M (MAX n)) = do
    tstore <- atomically $ newTVar (C (MyCounter n))
    return tstore   
resetCounter (N (MIN n)) = do
    tstore <- atomically $ newTVar (C (MyCounter n))
    return tstore     


decCounter' :: Countdown -> Countdown
decCounter' (C (MyCounter c)) = C (MyCounter (c - 1))

incCounter' :: Countdown -> Countdown
incCounter' (C (MyCounter c)) = C (MyCounter (c + 1))

inc :: CounterVar -> IO ()
inc tstore = do
	 v <- Lib.getTVar tstore
	 let newValue = incCounter' v
	 Lib.modifyTVar_ tstore newValue
	

decT :: CounterVar -> IO ()
decT r = do 
    v <- Lib.getTVar r
    let min' = N (MIN 0)
        newCounter = decCounter' v
    putStrLn $ show newCounter
    atomically $ (
        do
          check (myCompare min' v == LT )
          writeTVar r newCounter 
          --decT r
          )   
 
decCounter :: CounterVar -> Steps -> Int ->  IO ()
decCounter tstore s@(Steps n) i =  do
    c <- Lib.getTVar tstore
    let min' = N (MIN 0)
        newCounter = decCounter' c
        res = auxCompare min' c
    if  (auxCompare min' c == LT )
        then do
          Lib.modifyTVar_ tstore newCounter
          decCounter tstore (Steps (succ n)) i
        else (putStrLn $ "Finished Thread Number: " ++ (show i)) >> return ()
    where
        auxCompare x y = x `myCompare` y

countdown :: CounterVar -> Int -> IO ()            
countdown tstore 0 = return ()
countdown tstore n  = do
    forkIO $ decCounter tstore (Steps 0) n
    countdown tstore (n-1)
        
loopCounter :: CounterVar -> Int -> IO () 
loopCounter _ 0 = return ()
loopCounter tstore n = do
	c <- Lib.getTVar tstore
	putStrLn $ "Current value: " ++ (show c)
	loopCounter tstore (n-1)
	

module MyCLI
    ( 
        dispatch
    ) where

import qualified MyCounter as C
import qualified Lib as Lib


import qualified Data.Text as T
import Control.Concurrent.Async (replicateConcurrently_,async,wait,mapConcurrently_)
import Text.Read (readMaybe)
import GHC.Conc (numCapabilities)
import Control.Monad (forever)
import Control.Concurrent (forkIO,threadDelay)
import System.Random (mkStdGen,getStdGen,StdGen)
import Data.List (take)

lastBits :: Int
lastBits = 10

threshold :: Int
threshold = 100000

localHost :: Server.MyHost
localHost = Server.MyHost "127.0.0.1"

maxConns :: C.MAX
maxConns  = C.MAX 4096

dispatch :: String -> [String] -> IO ()
dispatch "countdown-test" args = countdownTest args
dispatch command args = doesntExist command args

doesntExist :: String -> [String] -> IO ()
doesntExist command _ = 
    putStrLn $ "The " ++ command ++ " command doesn't exist."


countdownTest :: [String] -> IO ()
countdownTest (nString:[]) = do
    let mn = readMaybe nString :: Maybe Int
    auxCountdowntest mn Nothing
countdownTest (nString:numString:[]) = do
    let mn = readMaybe nString :: Maybe Int
        mt = readMaybe numString :: Maybe Int
    auxCountdowntest mn mt
countdownTest _ = putStrLn "The countdown command takes exactly two arguments." 

auxCountdowntest :: Maybe Int -> Maybe Int -> IO ()
auxCountdowntest mn mt = do
    case (mn,mt) of
        (Just n,Just t) -> do
            tstore <- C.resetCounter (C.M (C.MAX n))
            r <- async $ C.loopCounter tstore n
            let nList = [1..t]
            mapConcurrently_ (\i -> C.decCounter tstore (C.Steps 0) i) nList
            c <- Lib.getTVar tstore
            putStrLn $ "Countdown from " ++ (show n) ++ " using " ++ (show t) ++ " cores stopped at: " ++ (show c)
        (Just n,_) -> do
            tstore <- C.resetCounter (C.M (C.MAX n))
            r <- async $ C.loopCounter tstore n
            let nList = [1..numCapabilities]
            mapConcurrently_ (\i -> C.decCounter tstore (C.Steps 0) i) nList
            c <- Lib.getTVar tstore
            putStrLn $ "Countdown from " ++ (show n) ++ " using " ++ (show numCapabilities) ++ " cores stopped at: " ++ (show c)
        _ -> putStrLn "The countdown command takes exactly two numbers."    

module Main (main) where

import System.Environment (getArgs)

main :: IO ()
main = do
	(command:argList) <- getArgs
	CLI.dispatch command argList

module Lib
    ( 
          modifyTVar_
        , getTVar
        , async 
        , printList
        , finiteRandoms
        , toString
    ) where

import Control.Monad (forever)
import Control.Concurrent.STM
import Control.Concurrent (forkIO)
import System.IO.Unsafe (unsafePerformIO)
import System.Random
import Data.List (intercalate)
import qualified Data.Text as T

data Async a = Async (TVar a)

--async :: IO a b -> TVar a -> b -> Int -> IO String
--async :: (IO a b) -> a -> b -> [Char] -> IO [Char]
async :: (Show c,Show b) => (a -> b -> IO ()) -> a -> b -> c -> IO ()
async action tstore x n = do
            tId <- forkIO ( do
                    r <- action tstore x
                    putStrLn $ "Finished Thread Number: " ++ (show n) ++ " :: "++(show r)
                    )
                   
            return ()
    

modifyTVar_ :: TVar a -> a -> IO ()
modifyTVar_ tv newVal = do
    atomically $ writeTVar tv newVal

-- gets the variable stored in a tv variable
getTVar :: TVar b -> IO b
getTVar tv  = do
    store <- atomically $ readTVar tv
    return store

getTvalue :: TVar (Maybe T.Text) -> String
getTvalue tstore = case (unsafePerformIO $ getTVar tstore) of
                        Just mytext -> T.unpack mytext
                        _ -> ""

printList :: (Show a) => [a] -> IO ()
printList xs = mapM_ print xs

toString :: (Show a) => [a] -> String
toString xs = intercalate ", " (map show xs)

finiteRandoms :: (RandomGen g, Random a, Num n, Eq n) => n -> g -> ([a],g)
finiteRandoms 0 gen = ([],gen)
finiteRandoms n gen =
    let (value,newGen) = random gen
        (restOfList, finalGen) =  finiteRandoms (n-1) newGen
    in (value:restOfList,finalGen)