mirror of
https://github.com/ilyakooo0/production-haskell.git
synced 2024-10-05 12:49:10 +03:00
.
This commit is contained in:
parent
14c9909fcb
commit
184c660d57
@ -34,6 +34,8 @@ import Data.Map (Map, empty, toList, insert, update, delete)
|
||||
import Data.Monoid (Sum(..))
|
||||
import qualified Data.Map
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (catMaybes, listToMaybe, mapMaybe)
|
||||
import Control.Applicative hiding (empty)
|
||||
|
||||
-- _ _ _ __ __ _ _
|
||||
-- | | (_)___| |_ | \/ | ___ _ __ ___ (_) __| |___
|
||||
@ -279,7 +281,9 @@ data DebitCard
|
||||
-- If the balance of the debit card after deducing the price of the coffee
|
||||
-- would become negative, return 'Nothing' from the function.
|
||||
chargeCoffee :: Coffee -> DebitCard -> Maybe DebitCard
|
||||
chargeCoffee = error "TODO: chargeCoffee"
|
||||
chargeCoffee coffee card
|
||||
| price coffee <= balance card = Just card {balance=balance card - price coffee}
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | How was the coffee charged.
|
||||
data PaymentMethod
|
||||
@ -327,7 +331,15 @@ data Customer
|
||||
-- NOTE: The customer can only buy a coffee with strictly one payment method.
|
||||
-- (Only one card or cash)
|
||||
payForCoffee :: Customer -> Coffee -> Maybe PaymentMethod
|
||||
payForCoffee = error "TODO: payForCoffee"
|
||||
payForCoffee customer coffee =
|
||||
let checkCard = chargeCoffee coffee
|
||||
goodCards :: Maybe PaymentMethod
|
||||
goodCards = fmap Card $ listToMaybe $ mapMaybe checkCard (cards customer)
|
||||
cashOption = if cash customer >= price coffee then
|
||||
Just $ Cash (cash customer - price coffee)
|
||||
else
|
||||
Nothing
|
||||
in goodCards <|> cashOption
|
||||
|
||||
-- | This function should apply the chosen payment method to the customer.
|
||||
-- In other words, it needs to apply the charge to the customer himself
|
||||
@ -338,12 +350,21 @@ payForCoffee = error "TODO: payForCoffee"
|
||||
--
|
||||
-- NOTE: You can not change the order of the cards.
|
||||
applyPayment :: Customer -> PaymentMethod -> Customer
|
||||
applyPayment = error "TODO: applyPayment"
|
||||
applyPayment customer paymentMethod =
|
||||
case paymentMethod of
|
||||
Cash change -> customer {cash = change }
|
||||
Card chargedCard ->
|
||||
let newCards = fmap (\card -> if cardId card == cardId chargedCard then chargedCard else card ) $ cards customer
|
||||
in customer {cards = newCards}
|
||||
|
||||
|
||||
-- | Performs the full payment (as in 'payForCoffee') and
|
||||
-- returns the modified customer (as in 'applyPayment').
|
||||
buyCoffee :: Customer -> Coffee -> Maybe Customer
|
||||
buyCoffee = error "TODO: buyCoffee"
|
||||
buyCoffee customer coffe =
|
||||
let maybePaymentMethod = payForCoffee customer coffe in
|
||||
fmap (applyPayment customer) maybePaymentMethod
|
||||
|
||||
|
||||
-- | You know that due to a medical condition the customer needs to watch his
|
||||
-- sugar intake. The new privacy-invading piece of ... technology can now
|
||||
@ -357,7 +378,14 @@ buyCoffee = error "TODO: buyCoffee"
|
||||
--
|
||||
-- NOTE: You can not change the order of the coffee.
|
||||
saveTheDiabetic :: [Coffee] -> (RUBAmount, [Coffee])
|
||||
saveTheDiabetic = error "TODO: saveTheDiabetic"
|
||||
saveTheDiabetic coffeeList =
|
||||
let isSugar = (`elem` [WhiteSugar, BrownSugar])
|
||||
sugarPrice extra = if isSugar extra then price extra else 0
|
||||
savedMonney = foldl (\savedMonney coffee -> savedMonney + (sum $ fmap sugarPrice $ extras coffee))
|
||||
0 coffeeList
|
||||
coffeesWithoutSugar = fmap (\coffee -> coffee {extras = filter (not . isSugar) $ extras coffee} ) coffeeList
|
||||
in (savedMonney, coffeesWithoutSugar)
|
||||
|
||||
|
||||
-- | And just to torment those who love sugar lets make a function which
|
||||
-- calculates health hazard (sugar content) of the given orders.
|
||||
@ -367,4 +395,11 @@ saveTheDiabetic = error "TODO: saveTheDiabetic"
|
||||
-- WhiteSugar: 2 extra danger points
|
||||
-- BrownSugar: 1 extra danger point
|
||||
calculateSugarDanger :: [Coffee] -> Int
|
||||
calculateSugarDanger = error "TODO: calculateSugarDanger"
|
||||
calculateSugarDanger coffeeList = sum $ fmap (
|
||||
\extra -> case extra of
|
||||
WhiteSugar -> 2
|
||||
BrownSugar -> 1
|
||||
_ -> 0) (coffeeList >>= extras)
|
||||
|
||||
-- (>>=) :: m a -> (a -> m b) -> m b
|
||||
-- (>>=) :: [a] -> (a -> [b]) -> [b]
|
@ -5,6 +5,7 @@ license: Unlicense
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
- mtl
|
||||
- QuickCheck
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
|
@ -1,5 +1,10 @@
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Task
|
||||
( calculate,
|
||||
Expr(..),
|
||||
)
|
||||
where
|
||||
|
||||
@ -7,6 +12,179 @@ import Control.Applicative
|
||||
import Control.Monad.State.Lazy
|
||||
import Data.Char
|
||||
import Data.Maybe
|
||||
import Test.QuickCheck
|
||||
import Text.Read
|
||||
import Debug.Trace
|
||||
import Control.Monad
|
||||
|
||||
type ParsingResult a = Either String (a, String)
|
||||
|
||||
-- Parser :: Type -> Type
|
||||
newtype Parser a = Parser (String -> ParsingResult a)
|
||||
deriving Functor
|
||||
|
||||
instance Applicative Parser where
|
||||
pure :: a -> Parser a
|
||||
pure x = Parser (\q -> Right (x, q))
|
||||
|
||||
(<*>) :: Parser (a -> b) -> Parser a -> Parser b
|
||||
(<*>)
|
||||
(Parser (e :: String -> ParsingResult (a -> b)))
|
||||
(Parser (x :: String -> ParsingResult a)) = Parser (\s ->
|
||||
case e s of
|
||||
Left err -> Left err
|
||||
Right (arr, sLeft) -> case x sLeft of
|
||||
Left err2 -> Left err2
|
||||
Right (resOfTypeA, sLeft2) -> Right (arr resOfTypeA, sLeft2))
|
||||
|
||||
instance Monad Parser where
|
||||
return :: a -> Parser a
|
||||
return = pure
|
||||
|
||||
(>>=) :: Parser a -> (a -> Parser b) -> Parser b
|
||||
(>>=) (Parser x) e = Parser (\s ->
|
||||
case x s of
|
||||
Left err -> Left err
|
||||
Right (a, s1) -> case e a of
|
||||
Parser f -> f s1
|
||||
)
|
||||
|
||||
instance MonadFail Parser where
|
||||
fail :: String -> Parser a
|
||||
fail err = Parser . const . Left $ err
|
||||
|
||||
instance Alternative Parser where
|
||||
empty :: Parser a
|
||||
empty = Parser . const . Left $ "I'm empty"
|
||||
|
||||
(Parser left) <|> (Parser right) = Parser $ \s -> case (left s, right s) of
|
||||
(Right res, _) -> Right res
|
||||
(Left _, Right res) -> Right res
|
||||
(Left err1, Left err2) -> Left $ "Both alternatives failed: 1) " ++ err1 ++ "\n2:" ++ err2
|
||||
|
||||
anyToken :: Parser Char
|
||||
anyToken = Parser $ \s -> case s of
|
||||
"" -> Left "Empty String"
|
||||
(hd: tl) -> Right (hd, tl)
|
||||
|
||||
eos :: Parser ()
|
||||
eos = Parser $ \s -> case s of
|
||||
"" -> Right ((), "")
|
||||
s -> Left $ "unexpected trailing content: " ++ s
|
||||
|
||||
token :: Char -> Parser ()
|
||||
-- token expected = Parser $ \s -> case s of
|
||||
-- "" -> Left "Empty String"
|
||||
-- (hd: tl) -> if hd == expected then Right ((), tl) else Left $
|
||||
token expected = do
|
||||
actual <- anyToken
|
||||
when (actual /= expected) $ fail $ "expected " ++ [expected] ++ ", got " ++ [actual]
|
||||
-- when :: Applicative f => Bool -> f () -> f ()
|
||||
|
||||
tokens :: String -> Parser ()
|
||||
tokens "" = pure ()
|
||||
tokens (c: cs) = do
|
||||
token c
|
||||
tokens cs
|
||||
|
||||
-- "x"
|
||||
-- u <- tokensWhile (== 'a')
|
||||
|
||||
tokensWhile :: (Char -> Bool) -> Parser String
|
||||
-- tokensWhile e = (do
|
||||
-- char <- anyToken
|
||||
-- str <- if e char then tokensWhile e else empty
|
||||
-- pure (char:str)) <|> (pure "")
|
||||
-- tokensWhile e = (do
|
||||
-- char <- anyToken
|
||||
-- str <- if e char then tokensWhile e else empty
|
||||
-- pure (char:str)) <|> (pure "")
|
||||
|
||||
tokensWhile e = tokensWhile1 e <|> pure ""
|
||||
|
||||
tokensWhile1 :: (Char -> Bool) -> Parser String
|
||||
tokensWhile1 e = do
|
||||
char <- anyToken
|
||||
-- traceShowM char
|
||||
str <- if e char then tokensWhile e else empty
|
||||
pure (char:str)
|
||||
|
||||
-- isDigit :: Char -> Bool
|
||||
|
||||
-- TODO: add negative numbers
|
||||
number:: Parser Int
|
||||
number = do
|
||||
chars <- tokensWhile1 isDigit
|
||||
case readMaybe chars of
|
||||
Just res -> return res
|
||||
Nothing -> fail $ "unexpected invalid number: '" ++ chars ++ "'"
|
||||
|
||||
data Expr
|
||||
= Num Int
|
||||
| AddExpr Expr Expr
|
||||
| MulExpr Expr Expr
|
||||
| SubExpr Expr Expr
|
||||
| DivExpr Expr Expr
|
||||
deriving Show
|
||||
|
||||
half :: Gen a -> Gen a
|
||||
half = scale (`div` 2)
|
||||
|
||||
instance Arbitrary Expr where
|
||||
arbitrary = do
|
||||
size <- getSize
|
||||
case size of
|
||||
0 -> Num <$> arbitrary
|
||||
otherwise ->
|
||||
oneof [
|
||||
Num <$> arbitrary,
|
||||
AddExpgr <$> half arbitrary <*> half arbitrary,
|
||||
SubExpr <$> half arbitrary <*> half arbitrary,
|
||||
MulExpr <$> half arbitrary <*> half arbitrary,
|
||||
DivExpr <$> half arbitrary <*> half arbitrary
|
||||
]
|
||||
|
||||
parse :: Parser Expr
|
||||
parse = Num <$> number <|> (do
|
||||
token '('
|
||||
tokensWhile isSpace
|
||||
expr1 <- parse
|
||||
tokensWhile isSpace
|
||||
operator <- anyToken
|
||||
tokensWhile isSpace
|
||||
expr2 <- parse
|
||||
tokensWhile isSpace
|
||||
token ')'
|
||||
case operator of
|
||||
'+' -> return $ AddExpr expr1 expr2
|
||||
'*' -> return $ MulExpr expr1 expr2
|
||||
'-' -> return $ SubExpr expr1 expr2
|
||||
'/' -> return $ DivExpr expr1 expr2
|
||||
_ -> fail "unknown operator"
|
||||
)
|
||||
|
||||
parseFull :: Parser Expr
|
||||
parseFull = do
|
||||
e <- parse
|
||||
eos
|
||||
return e
|
||||
|
||||
evaluate :: Expr -> Maybe Int
|
||||
evaluate (Num x) = Just x
|
||||
evaluate (AddExpr left right) = (+) <$> (evaluate left) <*> (evaluate right)
|
||||
evaluate (MulExpr left right) = (*) <$> (evaluate left) <*> (evaluate right)
|
||||
evaluate (SubExpr left right) = (-) <$> (evaluate left) <*> (evaluate right)
|
||||
evaluate (DivExpr _ right) | evaluate right == Just 0 = Nothing
|
||||
evaluate (DivExpr left right) = div <$> (evaluate left) <*> (evaluate right)
|
||||
|
||||
|
||||
runParser :: Parser x -> String -> Maybe x
|
||||
runParser (Parser parser_fun) context =
|
||||
case parser_fun context of
|
||||
Left msg -> trace msg Nothing
|
||||
Right (x, _) -> Just x
|
||||
|
||||
calculate :: String -> Maybe Int
|
||||
calculate = error "TODO: calculate"
|
||||
calculate s = do
|
||||
expression <- runParser parseFull s
|
||||
evaluate expression
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 2.2
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 20a39a4ec02d6e75694b336bd8631bf5d630fcaacb76de84c7263c8abe1c45b3
|
||||
-- hash: c2b1bcd2599c61a3fda41614499046ca5654131a2e5ac9976e0c07ec2b8887d8
|
||||
|
||||
name: task
|
||||
version: 0.1.0.0
|
||||
@ -21,7 +21,8 @@ library
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
QuickCheck
|
||||
, base >=4.7 && <5
|
||||
, mtl
|
||||
default-language: Haskell2010
|
||||
|
||||
@ -36,7 +37,8 @@ test-suite task-tests
|
||||
hs-source-dirs:
|
||||
test
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
QuickCheck
|
||||
, base >=4.7 && <5
|
||||
, mtl
|
||||
, task
|
||||
, tasty
|
||||
|
Loading…
Reference in New Issue
Block a user