Skip to content

Commit e85607f

Browse files
mantasavasmantasavas
committed
Complete first practise task
1 parent 8410583 commit e85607f

File tree

4 files changed

+477
-43
lines changed

4 files changed

+477
-43
lines changed

‎practise/1 task/Text-RawString-QQ.hs

+113
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,113 @@
1+
-- | Raw string literals, implemented using Template Haskell's quasiquotation
2+
-- feature.
3+
module Text.RawString.QQ (r, rQ)
4+
where
5+
6+
import Language.Haskell.TH
7+
import Language.Haskell.TH.Quote
8+
9+
{-|
10+
11+
A quasiquoter for raw string literals - that is, string literals that don't
12+
recognise the standard escape sequences (such as @\'\\n\'@). Basically, they
13+
make your code more readable by freeing you from the responsibility to escape
14+
backslashes. They are useful when working with regular expressions, DOS/Windows
15+
paths and markup languages (such as XML).
16+
17+
Don't forget the @LANGUAGE QuasiQuotes@ pragma if you're using this
18+
module in your code.
19+
20+
Usage:
21+
22+
@
23+
ghci> :set -XQuasiQuotes
24+
ghci> import Text.RawString.QQ
25+
ghci> let s = [r|\\w+\@[a-zA-Z_]+?\\.[a-zA-Z]{2,3}|]
26+
ghci> s
27+
\"\\\\w+\@[a-zA-Z_]+?\\\\.[a-zA-Z]{2,3}\"
28+
ghci> [r|C:\\Windows\\SYSTEM|] ++ [r|\\user32.dll|]
29+
\"C:\\\\Windows\\\\SYSTEM\\\\user32.dll\"
30+
@
31+
32+
Multiline raw string literals are also supported:
33+
34+
@
35+
multiline :: String
36+
multiline = [r|\<HTML\>
37+
\<HEAD\>
38+
\<TITLE\>Auto-generated html formated source\</TITLE\>
39+
\<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=windows-1252\"\>
40+
\</HEAD\>
41+
\<BODY LINK=\"#0000ff\" VLINK=\"#800080\" BGCOLOR=\"#ffffff\"\>
42+
\<P\> \</P\>
43+
\<PRE\>|]
44+
@
45+
46+
Caveat: since the @\"|]\"@ character sequence is used to terminate the
47+
quasiquotation, you can't use it inside the raw string literal. Use 'rQ' if you
48+
want to embed that character sequence inside the raw string.
49+
50+
For more on raw strings, see e.g.
51+
<http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2006/n2053.html>
52+
53+
For more on quasiquotation, see
54+
<http://www.haskell.org/haskellwiki/Quasiquotation>
55+
56+
-}
57+
r :: QuasiQuoter
58+
r = QuasiQuoter {
59+
-- Extracted from dead-simple-json.
60+
quoteExp = return . LitE . StringL . normaliseNewlines,
61+
62+
quotePat = \_ -> fail "illegal raw string QuasiQuote \
63+
\(allowed as expression only, used as a pattern)",
64+
quoteType = \_ -> fail "illegal raw string QuasiQuote \
65+
\(allowed as expression only, used as a type)",
66+
quoteDec = \_ -> fail "illegal raw string QuasiQuote \
67+
\(allowed as expression only, used as a declaration)"
68+
}
69+
70+
{-| A variant of 'r' that interprets the @\"|~]\"@ sequence as @\"|]\"@,
71+
@\"|~~]\"@ as @\"|~]\"@ and, in general, @\"|~^n]\"@ as @\"|~^(n-1)]\"@
72+
for n >= 1.
73+
74+
Usage:
75+
76+
@
77+
ghci> [rQ||~]|~]|]
78+
\"|]|]\"
79+
ghci> [rQ||~~]|]
80+
\"|~]\"
81+
ghci> [rQ||~~~~]|]
82+
\"|~~~]\"
83+
@
84+
-}
85+
rQ :: QuasiQuoter
86+
rQ = QuasiQuoter {
87+
quoteExp = return . LitE . StringL . escape_rQ . normaliseNewlines,
88+
89+
quotePat = \_ -> fail "illegal raw string QuasiQuote \
90+
\(allowed as expression only, used as a pattern)",
91+
quoteType = \_ -> fail "illegal raw string QuasiQuote \
92+
\(allowed as expression only, used as a type)",
93+
quoteDec = \_ -> fail "illegal raw string QuasiQuote \
94+
\(allowed as expression only, used as a declaration)"
95+
}
96+
97+
escape_rQ :: String -> String
98+
escape_rQ [] = []
99+
escape_rQ ('|':'~':xs) =
100+
let (tildas, rest) = span (== '~') xs
101+
in case rest of
102+
[] -> '|':'~':tildas
103+
(']':rs) -> '|':tildas ++ ']':escape_rQ rs
104+
rs -> '|':'~':tildas ++ escape_rQ rs
105+
escape_rQ (x:xs) = x : escape_rQ xs
106+
107+
-- See https://github.com/23Skidoo/raw-strings-qq/issues/1 and
108+
-- https://ghc.haskell.org/trac/ghc/ticket/11215.
109+
normaliseNewlines :: String -> String
110+
normaliseNewlines [] = []
111+
normaliseNewlines ('\r':'\n':cs) = '\n':normaliseNewlines cs
112+
normaliseNewlines (c:cs) = c:normaliseNewlines cs
113+

‎practise/1 task/battleship.hs

+148-43
Original file line numberDiff line numberDiff line change
@@ -1,44 +1,149 @@
1-
module MyModule where
2-
3-
import Data.List
4-
import Data.Char
5-
6-
-- Cordinates Of Shot:
7-
8-
-- {
9-
-- "coord": ["D", "7"],
10-
-- "result": "HIT",
11-
-- "prev": {
12-
-- "coord": ["A", "10"],
13-
-- "result": null,
14-
-- "prev": null
15-
-- }
16-
-- }
17-
18-
-- {"coord":["D","7"],"result":"HIT","prev":{"coord":["A","10"],"result":null,"prev":null}}
19-
20-
-- data MyBool a = MyFalse | MyTrue a
21-
-- deriving Show
22-
23-
data MoveMsg = DicMsg [(String, MoveMsg)]
24-
| CordList [MoveMsg]
25-
| CordValue String
26-
| Exist (Maybe MoveMsg)
27-
deriving Show
28-
29-
30-
-- Some examples of parsing data
31-
firstMove :: MoveMsg
32-
firstMove = DicMsg [
33-
("coord", CordList[CordValue "A", CordValue "10"]),
34-
("result", Exist Nothing),
35-
("prev", Exist Nothing)
36-
]
37-
38-
secondMove :: MoveMsg
39-
secondMove = DicMsg [
40-
("coord", CordList[CordValue "D", CordValue "7"]),
41-
("result", CordValue "HIT"),
42-
("prev", firstMove)
43-
]
1+
module BattleShip where
442

3+
import Parser
4+
import GameData
5+
6+
printSimple :: String -> String
7+
printSimple msg = msg
8+
9+
-- Resolves errors
10+
resolveEithers :: Either String a -> a
11+
resolveEithers (Right msg) = msg
12+
13+
getPlayersShots :: Either String MoveMsg -> [MoveMsg]
14+
getPlayersShots msg = playerMoves "coord" $ (resolveEithers msg)
15+
16+
resolveError :: Either String a -> String
17+
resolveError (Left msg) = msg
18+
19+
-- Checks if we reached the end of data structure recursively
20+
isTheEnd :: MoveMsg -> Bool
21+
isTheEnd (DicMsg msg) = False
22+
isTheEnd (CordValue "null") = True
23+
24+
------- Checking if the game end symbol is the last one ------
25+
26+
checkEmptyCoord :: MoveMsg -> Bool
27+
checkEmptyCoord (CordList []) = True
28+
checkEmptyCoord (CordList _) = False
29+
30+
checkGameEndSymbol :: [MoveMsg] -> Bool
31+
checkGameEndSymbol [] = False
32+
checkGameEndSymbol (head:tail) | checkGameEndSymbol tail == True = True
33+
| checkEmptyCoord head == True = True
34+
| otherwise = False
35+
36+
checkIfFirstEndSymb :: [MoveMsg] -> Bool
37+
checkIfFirstEndSymb (head:tail) | checkEmptyCoord head == True && checkGameEndSymbol tail == False = True
38+
| checkEmptyCoord head == False && checkGameEndSymbol tail == False = True
39+
| otherwise = False
40+
41+
-------------------------------------------------------------
42+
43+
getCoorValue :: MoveMsg -> String
44+
getCoorValue (CordList [CordValue x, CordValue y]) = x ++ y
45+
getCoorValue (CordList []) = ""
46+
47+
firstPlayerCoord :: ([MoveMsg], [MoveMsg]) -> [MoveMsg]
48+
firstPlayerCoord (msg, _) = msg
49+
50+
secondPlayerCoord :: ([MoveMsg], [MoveMsg]) -> [MoveMsg]
51+
secondPlayerCoord (_, msg) = msg
52+
53+
-- Based on key, returns value of MoveMsg data structure
54+
getKeyValue :: String -> MoveMsg -> (String, MoveMsg)
55+
getKeyValue ("coord") (DicMsg msg) = msg!!0
56+
getKeyValue ("result") (DicMsg msg) = msg!!1
57+
getKeyValue ("prev") (DicMsg msg) = msg!!2
58+
59+
60+
-- Can return either all the cordinates or shoot results of both players combined
61+
-- Recursively iterrates through MoveMsg and returns player moves
62+
playerMoves :: String -> MoveMsg -> [MoveMsg]
63+
playerMoves key msg = accCoordinates msg
64+
where
65+
accCoordinates :: MoveMsg -> [MoveMsg]
66+
accCoordinates msg =
67+
let
68+
(_, nextMsg) = getKeyValue "prev" msg
69+
(_, result) = getKeyValue key msg
70+
in
71+
if isTheEnd nextMsg then result:[]
72+
else result:(accCoordinates nextMsg)
73+
74+
-- Returns shooting coordinates of both players separated
75+
getShootingCoordinates :: [MoveMsg] -> [MoveMsg] -> [MoveMsg] -> ([MoveMsg], [MoveMsg])
76+
getShootingCoordinates [] accFirsPlayer accSecondPlayer = (accFirsPlayer, accSecondPlayer)
77+
getShootingCoordinates (head:tail) accFirsPlayer accSecondPlayer
78+
| length tail `mod` 2 == 0 = (getShootingCoordinates tail (head:accFirsPlayer) accSecondPlayer)
79+
| otherwise = (getShootingCoordinates tail accFirsPlayer (head:accSecondPlayer))
80+
81+
82+
countPlayerCoordinates :: Either String ([MoveMsg], [MoveMsg]) -> Either String (Int, Int)
83+
countPlayerCoordinates shootingCoords =
84+
let
85+
(firstPlayer, secondPlayer) | isRight(shootingCoords) == "True" = resolveEithers shootingCoords
86+
in
87+
if isRight(shootingCoords) == "True"
88+
then Right (100 - (length firstPlayer), (100 - (length secondPlayer)))
89+
else Left (resolveError shootingCoords)
90+
91+
-- Combines coordinate, so that later it could be easy to compare if before A 1 seperated => A1
92+
combineCoordinate :: [MoveMsg] -> [String]
93+
combineCoordinate [] = []
94+
combineCoordinate (head:tail) = (getCoorValue head):(combineCoordinate tail)
95+
96+
97+
-- Every time it comes back checks if True, if true, doesn't check anymore
98+
-- Checks for multiple shots, if true wrong!
99+
checkMultipleShots :: [MoveMsg] -> Bool
100+
checkMultipleShots [] = False
101+
checkMultipleShots (head:tail) | checkMultipleShots tail == True = True
102+
| otherwise = ((getCoorValue head) `elem` (combineCoordinate tail))
103+
104+
105+
checkGameLogic :: Either String ([MoveMsg], [MoveMsg]) -> Either String MoveMsg -> (Bool, Bool, Bool)
106+
checkGameLogic shootingCoords parsedMessage =
107+
let
108+
-- Checking for duplicate shots for first player
109+
firstPlayerDup = checkMultipleShots (firstPlayerCoord (resolveEithers shootingCoords))
110+
111+
-- Checking for duplicate shots for second player
112+
secondPlayerDup = checkMultipleShots (secondPlayerCoord (resolveEithers shootingCoords))
113+
114+
-- checking for end symbol, must be at the end!
115+
endSymbolCorrect = (checkGameEndSymbol (getPlayersShots parsedMessage) == True) && (checkIfFirstEndSymb (getPlayersShots parsedMessage) == False)
116+
in
117+
(firstPlayerDup, secondPlayerDup, endSymbolCorrect)
118+
119+
120+
resolveCheckGameLogic :: (Bool, Bool, Bool) -> Either String String
121+
resolveCheckGameLogic (True, _, _) = Left("Game end symbol is in wrong position! Must be at the end")
122+
resolveCheckGameLogic (_, True, _) = Left("First Player duplicate shots!")
123+
resolveCheckGameLogic (_, _, True) = Left("Second Player duplicate shots!")
124+
resolveCheckGameLogic (_, _, _) = Right("All Logic Valid")
125+
126+
127+
-- Finds number of moves available for a players
128+
available :: String -> Either String (Int, Int)
129+
available msg =
130+
let
131+
parsedMessage = parseMessage msg
132+
shootingCoords | isRight(parsedMessage) == "False" = Left (resolveError parsedMessage)
133+
| otherwise = Right (getShootingCoordinates (getPlayersShots parsedMessage) [] [])
134+
135+
(firstPlayerDup, secondPlayerDup, endSymbolCorrect) | isRight(shootingCoords) == "True" = checkGameLogic shootingCoords parsedMessage
136+
| otherwise = (False, False, False)
137+
logicError = resolveCheckGameLogic(endSymbolCorrect, firstPlayerDup, secondPlayerDup)
138+
in
139+
-- Checks for all the logical error in message
140+
if isRight(logicError) == "False"
141+
then Left(resolveError logicError)
142+
-- Checks if JSON is correct format
143+
else if isRight(shootingCoords) == "False"
144+
then Left(resolveError shootingCoords)
145+
-- If finds out that end symbol exist, end game symbol [], no available moves!
146+
else if checkGameEndSymbol (getPlayersShots parsedMessage) == True
147+
then Right(0,0)
148+
-- If everything is okey, main scenario, return available moves for both players
149+
else countPlayerCoordinates shootingCoords

0 commit comments

Comments
 (0)