API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 4th, 2016
67
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Haskell 14.28 KB | None | 0 0
raw download clone embed print report
  1. {-# LANGUAGE OverloadedStrings #-}
  2.  
  3. module Main where
  4.  
  5. import Network.HTTP.Conduit
  6. import Network.HTTP.Types
  7. import qualified Data.ByteString.Lazy as L
  8. import Data.Char (chr)
  9. import qualified Data.ByteString as B
  10. import qualified Data.ByteString.Lazy.Char8 as C
  11. import Language.Haskell.TH.Ppr
  12.  
  13.  
  14. data BoardMove   = BoardMove {
  15.   bMove ::(Int, Int, Char)
  16. } deriving Show
  17. type Board = [BoardMove]
  18.  
  19. url :: String
  20. url = "http://tictactoe.homedir.eu/game/kim2/player/2"
  21.  
  22. type Move = (Int, Int, Char)
  23. type Moves = [Move]
  24.  
  25. parse :: String -> Moves
  26.  
  27. parse ('M':'a':'p':'(':rest) = reverse $ stringTuples [] rest
  28. parse _ = error "Not a map"
  29.  
  30. readDigit :: String -> (Int, String)
  31. readDigit ('0':rest) = (0, rest)
  32. readDigit ('1':rest) = (1, rest)
  33. readDigit ('2':rest) = (2, rest)
  34. readDigit _ = error "Digit expected"
  35.  
  36. readPlayer :: String -> (Char, String)
  37. readPlayer ('x': rest) = ('x', rest)
  38. readPlayer ('o': rest) = ('o', rest)
  39. readPlayer _ = error "Player expected"
  40.  
  41. readSeparator :: String -> String
  42. readSeparator (',':rest) = readSeparator rest
  43. readSeparator ('(':rest) = ('(':rest)
  44. readSeparator ('M':'a':'p':rest) = rest
  45. readSeparator ('0':rest) = readSeparator rest
  46. readSeparator ('1':rest) = readSeparator rest
  47. readSeparator ('2':rest) = readSeparator rest
  48. readSeparator ('3':rest) = readSeparator rest
  49. readSeparator ('4':rest) = readSeparator rest
  50. readSeparator ('5':rest) = readSeparator rest
  51. readSeparator ('6':rest) = readSeparator rest
  52. readSeparator ('7':rest) = readSeparator rest
  53. readSeparator ('8':rest) = readSeparator rest
  54. readSeparator ('9':rest) = readSeparator rest
  55. readSeparator('-':'>':rest) = readSeparator rest
  56. readSeparator(' ':rest) = readSeparator rest
  57. readSeparator _ = "No separator"
  58.  
  59. superParser :: String -> String
  60. superParser('x':rest) = superParser rest
  61. superParser('y':rest) = superParser rest
  62. superParser('v':rest) = superParser rest
  63. superParser('-':'>':rest) = spaceParser rest
  64. superParser(' ':rest) = superParser rest
  65. superParser(',':rest) = superParser rest
  66. superParser _ = error "superParser error"
  67.  
  68.  
  69.  
  70. spaceParser :: String -> String
  71. spaceParser (' ':rest) = spaceParser rest
  72. spaceParser ('0':rest) = ('0':rest)
  73. spaceParser ('1':rest) = ('1':rest)
  74. spaceParser ('2':rest) = ('2':rest)
  75. spaceParser ('x':rest) = ('x':rest)
  76. spaceParser ('o':rest) = ('o':rest)
  77. spaceParser _ = error "spaceParser"
  78.  
  79. stringTuples acc ")" = acc
  80. stringTuples acc rest =
  81.   let
  82.     sepRest = readSeparator rest
  83.     (tuple, restt) = stringTuple sepRest
  84.    
  85.   in
  86.     stringTuples (tuple:acc) restt
  87.  
  88. stringTuple :: String -> ((Int, Int, Char), String)
  89. stringTuple ('(':rest) =
  90.   let
  91.     resto = superParser rest
  92.     (x, restx) = readDigit resto
  93.     sep1Rest = superParser restx
  94.     (y, resty) = readDigit sep1Rest
  95.     sep2Rest = superParser resty
  96.     (p, restp) = readPlayer sep2Rest
  97.   in
  98.     case restp of
  99.       (')':t) -> ((x, y, p), t)
  100.       _       -> error "Tuple without closing bracket"
  101. stringTuple _ = error "No tuple"     
  102.  
  103.  
  104. validate :: String -> Bool
  105. validate rest =
  106.     let
  107.       x = parse rest
  108.     in
  109.       if x == [] then True
  110.       else validCheck x
  111.      
  112. validCheck :: Moves -> Bool
  113. validCheck moves =
  114.     let
  115.       x = cmp moves moves
  116.       y = greatMoves moves
  117.       z = cmp2 moves
  118.     in
  119.       if x == True && y == True && z == True then True
  120.       else False
  121.      
  122.  
  123. cmp :: Moves -> Moves -> Bool  
  124. cmp moves moves2 =
  125.     let
  126.       l1 = moves
  127.       l2 = tail moves2
  128.       l2Tail = tail l2
  129.       l1Tup = head l1
  130.       l2Tup = head l2
  131.       l1Tail = tail l1
  132.     in
  133.       if l1Tail == [] then True
  134.       else if l1Tup == l2Tup then False
  135.       else if l2Tail == [] then cmp l1Tail l1Tail
  136.       else cmp l1 l2
  137.      
  138. cmp2 :: Moves -> Bool
  139. cmp2 moves =
  140.     let
  141.       l1 =  head moves
  142.       l1t = tail moves
  143.       l2 = head l1t
  144.       l1tup = getCord l1
  145.       l2tup = getCord l2
  146.     in
  147.       if l1t == [] then True
  148.       else if l1tup == l2tup then False
  149.       else cmp2 l1t
  150.      
  151. logikavienas :: Moves -> Moves
  152. logikavienas moves = [(0,0,'x')]
  153.  
  154.  
  155. logikadu :: Moves -> Moves
  156. logikadu moves =
  157.     let
  158.       ot = head moves
  159.     in  
  160.       if ot == (1,1, 'o') then [(2,2, 'x'),ot,(0,0,'x')]
  161.       else if ot /= (0,1, 'o') then [(0,2, 'x'),ot,(0,0, 'x')]
  162.       else if ot == (0,1, 'o') then [(2,0, 'x'),ot,(0,0,'x')]
  163.       else []
  164.      
  165. {--logikatres :: Moves -> Moves
  166. logikatres moves =
  167.   let
  168.     rest = tail moves
  169.     ot = head moves
  170.     rest2 = tail rest
  171.     ot2 = head rest
  172.   in  
  173.     if ot == (1,1,'o') && ot2 /= (0,1,'o') then [(0,1,'x'),ot,(0,2,'x'),ot2,(0,0,'x')]
  174.     else if ot == (1,1,'o') && ot2 == (0,1,'o') then [(1,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  175.     else if ot /= (0,1,'o') && ot2 /= (1,1,'o') && ot2 /= (0,1,'o') then [(1,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  176.     else if ot == (0,1,'o') && ot2 /= (1,1,'o') && ot2 /= (0,1,'o') then [(1,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  177.     else if ot == (0,2,'o') then [(2,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  178.     else if ot == (2,0,'o') then [(0,2,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  179.     else if ot == (0,1,'o') then [(2,1,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  180.     else if ot == (2,1,'o') then [(0,1,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  181.     else if ot == (1,0,'o') then [(1,2,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  182.     else if ot == (1,2,'o') then [(1,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  183.     else []
  184.     --}
  185. {--
  186. logikaquatro :: Moves -> Moves   
  187.     let
  188.       rest = tail moves
  189.       ot = head moves
  190.       rest = tail rest
  191.       ot2 = head rest
  192.       rest = tail rest
  193.       rest = tail rest
  194.       ot3 = head rest
  195.     in  
  196.       if ot3 != (1,1,'o') && ot2 == (0,1,'o') then [(0,1,'x'),ot,(0,2,'x'),ot2,(0,0,'x')]
  197.       else if ot == (1,1,'o') && ot2 == (0,1,'o') then [(1,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  198.       else if ot == (0,2,'o') then [(2,0,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  199.       else if ot == (2,0,'o') then [(0,2,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  200.       else if ot == (a,b,c) && mod a 3 != 1 then [(mod a+2 3,b,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  201.       else if ot == (a,b,c) && mod a 3 == 1 then [(a,mod b+2 3,'x'),ot,(2,0,'x'),ot2,(0,0,'x')]
  202. --}
  203.      
  204.      
  205. greatMoves :: Moves -> Bool
  206. greatMoves moves =
  207.     let
  208.       l2 =  tail moves
  209.       l1 =  moves
  210.       l1T = head moves
  211.       l2T = head l2
  212.       l1H = getPlayer l1T
  213.       l2H = getPlayer l2T
  214.     in
  215.       if l2 == [] then True
  216.       else if l1H == l2H then False
  217.       else greatMoves l2
  218.  
  219. getPlayer :: Move -> Char
  220. getPlayer (_,_,p) = p    
  221.  
  222. getCord :: Move -> (Int,Int)  
  223. getCord (a,b,_) = (a,b)
  224.  
  225. getMove :: Moves -> Move
  226. getMove a = head a
  227.  
  228. win :: Board -> Char -> Bool
  229. win b c =
  230.   if checkRow 0 b c || checkRow 1 b c || checkRow 2 b c then True
  231.   else if checkCol 0 b c || checkCol 1 b c || checkCol 2 b c then True
  232.   else if length (filter(\(BoardMove(r, col, m)) -> r == 0 && col == 0 && m == c) b) + length (filter(\(BoardMove(r, col, m)) -> r == 1 && col == 1 && m == c) b) + length (filter(\(BoardMove(r, col, m)) -> r == 2 && col == 2 && m == c) b) == 3 then True
  233.   else if length (filter(\(BoardMove(r, col, m)) -> r == 0 && col == 2 && m == c) b) + length (filter(\(BoardMove(r, col, m)) -> r == 1 && col == 1 && m == c) b) + length (filter(\(BoardMove(r, col, m)) -> r == 2 && col == 0 && m == c) b) == 3 then True
  234.   else False
  235.  
  236. checkRow :: Int -> Board -> Char -> Bool
  237. checkRow num b c = length (filter(\(BoardMove(r, _, m)) -> r == num && m == c) b) == 3
  238.  
  239. checkCol :: Int -> Board -> Char -> Bool
  240. checkCol num b c = length (filter(\(BoardMove(_, col, m)) -> col == num && m == c) b) == 3
  241.  
  242. addToBoard :: BoardMove -> Board -> Board
  243. addToBoard m [] = [m]
  244. addToBoard m b = (m:b)
  245.  
  246.  
  247. buildGetRequest :: IO Request
  248. buildGetRequest = do
  249.   req0 <- parseUrl "http://tictactoe.homedir.eu/game/pivo74/player/1"
  250.  
  251.   return(req0 { method = methodGet
  252.                  , requestHeaders = [("Accept", "application/scala+map")]
  253.                  })
  254.                  
  255. --buildPostRequest :: String -> IO Request
  256. buildPostRequest message = do
  257.   req0 <- parseUrl "http://tictactoe.homedir.eu/game/pivo74/player/1"
  258.  
  259.   return(req0 { method = methodPost
  260.                  , requestHeaders = [("Content-Type", "application/scala+map")]
  261.                  , requestBody = RequestBodyLBS $ C.pack message} {--$ C.pack msg--}
  262.                  )
  263.  
  264.                  
  265. sendRequest a = do
  266.   manager <- newManager conduitManagerSettings
  267.   req <- a
  268.   res <- httpLbs req manager
  269.   return (responseBody res)
  270.  
  271. readSmth buildReq = do
  272.   a <- sendRequest buildReq
  273.   return a
  274.  
  275.  
  276. requestToString b = do
  277.   c <- sendRequest b
  278.   let d = lazyToString c
  279.   return d
  280.    
  281. lazyToString lazy =
  282.     let
  283.       byte = L.toStrict lazy
  284.       c = bsToStr byte
  285.     in
  286.       c
  287.  
  288. bsToStr :: B.ByteString -> String
  289. bsToStr = map (chr . fromEnum) . B.unpack
  290.  
  291. parseGetRequest toParse = do
  292.   stringParse <- requestToString toParse
  293.   let parsed = parse stringParse
  294.   return parsed
  295.    
  296.    
  297. row :: Moves -> Int -> Char  -> Bool
  298. row moves x a=(length(filter (\(x1,_,a1)->(x==x1&&a==a1)) moves)==2) && (length(filter (\(x1,_,_)->(x==x1)) moves)==2)
  299.  
  300. col :: Moves -> Int -> Char -> Bool
  301. col moves y a=(length(filter (\(_,y1,a1)->(y==y1&&a==a1)) moves)==2) && (length(filter (\(_,y1,_)->(y==y1)) moves)==2)
  302.  
  303. diag1 :: Moves -> Char -> Bool
  304. diag1 moves a=(length(filter (\(x,y,a1)->(((x==0&&y==0)||(x==1&&y==1)||(x==2&&y==2))&&a==a1)) moves)==2) && (length(filter (\(x,y,_)->(((x==0&&y==0)||(x==1&&y==1)||(x==2&&y==2)))) moves)==2)
  305.  
  306. diag2 :: Moves -> Char -> Bool
  307. diag2 moves a=(length(filter (\(x,y,a1)->(((x==2&&y==0)||(x==1&&y==1)||(x==0&&y==2))&&a==a1)) moves)==2) && (length(filter (\(x,y,_)->(((x==2&&y==0)||(x==1&&y==1)||(x==0&&y==2)))) moves)==2)
  308.  
  309. rowput::Moves -> Int -> Moves
  310. rowput moves x=
  311.   if length(filter (\(x1,y,_)->(x==x1&&y==0)) moves)==0 then (x,0,'x') : moves
  312.   else if length(filter (\(x1,y,_)->(x==x1&&y==1)) moves)==0 then (x,1,'x') : moves
  313.   else (x,2,'x') : moves
  314.  
  315.  
  316. colput::Moves -> Int -> Moves
  317. colput moves y=
  318.   if length(filter (\(x,y1,_)->(y==y1&&x==0)) moves)==0 then (0,y,'x') : moves
  319.   else if length(filter (\(x,y1,_)->(y==y1&&x==1)) moves)==0 then (1,y,'x') : moves
  320.   else (2,y,'x') : moves
  321.  
  322. diag1put::Moves -> Moves
  323. diag1put moves=
  324.   if length(filter (\(x,y,_)->((x==0&&y==0))) moves)==0 then (0,0,'x') : moves
  325.   else if length(filter (\(x,y,_)->((x==1&&y==1))) moves)==0 then (1,1,'x') : moves
  326.   else (2,2,'x') : moves
  327.  
  328. diag2put::Moves -> Moves
  329. diag2put moves=
  330.   if length(filter (\(x,y,_)->((x==2&&y==0))) moves)==0 then (2,0,'x') : moves
  331.   else if length(filter (\(x,y,_)->((x==1&&y==1))) moves)==0 then (1,1,'x') : moves
  332.   else (0,2,'x') : moves
  333.  
  334. put::Moves -> Moves
  335. put moves=
  336.   if length(filter (\(x,y,_)->(x==1&&y==1)) moves)==0 then (1,1,'x') : moves
  337.   else if length(filter (\(x,y,_)->(x==1&&y==0)) moves)==0 then (1,0,'x') : moves
  338.   else if length(filter (\(x,y,_)->(x==2&&y==0)) moves)==0 then (2,0,'x') : moves
  339.   else if length(filter (\(x,y,_)->(x==0&&y==1)) moves)==0 then (0,1,'x') : moves
  340.   else if length(filter (\(x,y,_)->(x==0&&y==0)) moves)==0 then (0,0,'x') : moves
  341.   else if length(filter (\(x,y,_)->(x==2&&y==1)) moves)==0 then (2,1,'x') : moves
  342.   else if length(filter (\(x,y,_)->(x==0&&y==2)) moves)==0 then (0,2,'x') : moves
  343.   else if length(filter (\(x,y,_)->(x==1&&y==2)) moves)==0 then (1,2,'x') : moves
  344.   else (2,2,'x') : moves
  345.  
  346. check2::Moves -> Moves
  347. check2 moves=
  348.     if row moves 0 'x' then  rowput moves 0
  349.     else if row moves 1 'x' then  rowput moves 1
  350.     else if row moves 2 'x' then  rowput moves 2
  351.     else if col moves 0 'x' then  colput moves 0
  352.     else if col moves 1 'x' then  colput moves 1
  353.     else if col moves 2 'x' then  colput moves 2
  354.     else if diag1 moves 'x' then  diag1put moves
  355.     else if diag2 moves 'x' then  diag2put moves
  356.     else if row moves 0 'o' then  rowput moves 0
  357.     else if row moves 1 'o' then  rowput moves 1
  358.     else if row moves 2 'o' then  rowput moves 2
  359.     else if col moves 0 'o' then  colput moves 0
  360.     else if col moves 1 'o' then  colput moves 1
  361.     else if col moves 2 'o' then  colput moves 2
  362.     else if diag1 moves 'o' then  diag1put moves
  363.     else if diag2 moves 'o' then  diag2put moves
  364.     else put moves
  365.  
  366. movesToString:: Moves -> String
  367. movesToString moves =
  368.   let
  369.     string = stringTuples2 moves 0 ""
  370.   in
  371.     string
  372.  
  373. stringTuples2:: Moves -> Int -> String -> String
  374. stringTuples2 moves counter string =
  375.   let
  376.     headTuple = head moves
  377.     movesTail = tail moves
  378.     str = string++ stringTuple2 counter headTuple
  379.     c = counter + 1
  380.   in
  381.     if movesTail /= [] || counter == 9 then stringTuples2 movesTail c str
  382.     else str++ ")"
  383.  
  384. stringTuple2:: Int -> Move -> String
  385. stringTuple2 counter tuple =
  386.   let
  387.     turnNr = turnNumber counter
  388.   in
  389.     if tuple == (0,0,'x') then turnNr++ "x -> 0, y -> 0, v-> x)"
  390.     else if tuple == (0,1,'x') then turnNr++ "x -> 0, y -> 1, v-> x)"
  391.     else if tuple == (0,2,'x') then turnNr++ "x -> 0, y -> 2, v-> x)"
  392.     else if tuple == (1,0,'x') then turnNr++ "x -> 1, y -> 0, v-> x)"
  393.     else if tuple == (1,1,'x') then turnNr++ "x -> 1, y -> 1, v-> x)"
  394.     else if tuple == (1,2,'x') then turnNr++ "x -> 1, y -> 2, v-> x)"
  395.     else if tuple == (2,0,'x') then turnNr++ "x -> 2, y -> 0, v-> x)"
  396.     else if tuple == (2,1,'x') then turnNr++ "x -> 2, y -> 1, v-> x)"
  397.     else if tuple == (2,2,'x') then turnNr++ "x -> 2, y -> 2, v-> x)"
  398.     else if tuple == (0,0,'o') then turnNr++ "x -> 0, y -> 0, v-> o)"
  399.     else if tuple == (0,1,'o') then turnNr++ "x -> 0, y -> 1, v-> o)"
  400.     else if tuple == (0,2,'o') then turnNr++ "x -> 0, y -> 2, v-> o)"
  401.     else if tuple == (1,0,'o') then turnNr++ "x -> 1, y -> 0, v-> o)"
  402.     else if tuple == (1,1,'o') then turnNr++ "x -> 1, y -> 1, v-> o)"
  403.     else if tuple == (1,2,'o') then turnNr++ "x -> 1, y -> 2, v-> o)"
  404.     else if tuple == (2,0,'o') then turnNr++ "x -> 2, y -> 0, v-> o)"
  405.     else if tuple == (2,1,'o') then turnNr++ "x -> 2, y -> 1, v-> o)"
  406.     else if tuple == (2,2,'o') then turnNr++ "x -> 2, y -> 2, v-> o)"
  407.     else ""
  408.  
  409. turnNumber:: Int -> String
  410. turnNumber counter =
  411.   if counter == 0 then "Map(0 -> Map("
  412.   else if counter == 1 then ", 1 -> Map("
  413.   else if counter == 2 then ", 2 -> Map("
  414.   else if counter == 3 then ", 3 -> Map("
  415.   else if counter == 4 then ", 4 -> Map("
  416.   else if counter == 5 then ", 5 -> Map("
  417.   else if counter == 6 then ", 6 -> Map("
  418.   else if counter == 7 then ", 7 -> Map("
  419.   else if counter == 8 then ", 8 -> Map("
  420.   else ""  
  421.  
  422. postBoard b = sendRequest xe
  423.   where
  424.     --pm=packMess b
  425.     xe = buildPostRequest b  
  426.  
  427.    
  428. main :: IO()
  429. main = do
  430.   putStrLn "Game End"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!