module Mahjong.Hand where

import Mahjong.Set
import Mahjong.Tile
import Data.List (sort)
import Data.Maybe
import Control.Monad

data Hand = Hand {getHand::MSet, getCall::[MSet]}
    deriving (Show)

max2Win = 7

pairs :: Int -> [MTile] -> Int
pairs c (h:hs) = (if length (filter (==h) hs) >= c then 1 else 0) + (pairs c $ filter (/=h) hs)
pairs c [] = 0

seven' h = 7 - (pairs 1 h)
musou' h = 14 - (pairs 0 h') - (if pairs 1 h' > 0 then 1 else 0)
    where h' = filter is19 h

seven = seven'.getHand
musou = musou'.getHand

-- For normal xAAA+yBCD+EE is easy
--  First calculate the maximum number of x+y then the number of partials
normal h = minimum $ map nlisten $ normalSet h

normalSet :: Hand -> [([MSet],[MSet],[MSet],MSet)]
normalSet h = do
    (set,r) <- setTest $ sort $ getHand h
    (part,rr) <- partTest $ sort $ r
    return (getCall h,set,part,rr)

nlisten :: ([MSet],[MSet],[MSet],MSet) -> Int
nlisten (call,set,part,rr) = rem
    where
        pair = min 1 $ length (filter (\(t1:t2:t) -> t1==t2) part)
        cal = 4 - (length call) - (length set)
        rem = cal * 2 - (min cal ((length part)-pair)) + 1 - pair

setTest :: MSet -> [([MSet],MSet)]
setTest t@(t1:t2:t3:ts) = (bcdTest)++(aaaTest)++other
    where aaaTest = 
            do
                guard (t1==t2 && t1==t3)
                (res,h) <- setTest ts
                return ([t1,t2,t3]:res,h)
          jt1 = Just t1
          jn1 = nextTile jt1
          jn2 = nextTile jn1
          bcdTest =
            do
                (tt,rem) <- tryTiles [jt1,jn1,jn2] t
                (res,h) <- setTest rem
                return (tt:res,h)
          other = do
            (res,h) <- setTest $ tail t
            return (res,t1:h)
setTest t = [([],t)]

partTest :: MSet -> [([MSet],MSet)]
partTest t@(t1:t2:ts) = aaTest ++ bcTest ++ bdTest ++ other
    where aaTest = 
            do
                guard (t1==t2)
                (res,h) <- partTest ts
                return ([t1,t2]:res,h)
          jt1 = Just t1
          jn1 = nextTile jt1
          jn2 = nextTile jn1
          bcTest = 
            do 
                (tt,rem) <- tryTiles [jn1,jt1] t
                (res,h) <- partTest rem
                return (tt:res,h)
          bdTest =
            do 
                (tt,rem) <- tryTiles [jn2,jt1] t
                (res,h) <- partTest rem
                return (tt:res,h)
          other = 
            do
                (res,h) <- partTest $ tail t
                return (res,t1:h)
partTest t = [([],t)]

rmTile :: Eq a => [a] -> a -> [a]
rmTile ts t = (takeWhile (/=t) ts) ++ if h == [] then [] else tail h
    where h = (dropWhile (/=t) ts)

listen :: Hand -> Int
listen h = max 0 $ minimum $ [seven,musou,normal] <*> [h]

nextTileSet :: Hand -> MSet
nextTileSet h@(Hand hand call) = [ tile | tile <- orderedTile, (>) l $ listen $ Hand (tile:hand) call]
    where 
        l = listen h

trySet :: [[Maybe MTile]] -> Hand -> [(MSet,Hand)]
trySet tiles h@(Hand hand call) = map (\(tt,rr) -> (tt,Hand rr (tt:call))) $ concat $ tryTiles <$> tiles <*> [hand]

chi :: Hand -> MTile -> [(MSet,Hand)]
chi h t = trySet [[p2,p1],[p1,n1],[n1,n2]] h 
    where
        p1 = prevTile $ Just t
        p2 = prevTile p1
        n1 = nextTile $ Just t
        n2 = nextTile n1

peng :: Hand -> MTile -> [(MSet,Hand)]
peng h t = trySet [[jt,jt]] h
    where jt = Just t
ankang :: Hand -> MTile -> [(MSet,Hand)]
ankang h@(Hand hand call) t = trySet (map ((take 4).repeat.Just) orderedTile) (Hand (t:hand) call)
mingkang :: Hand -> MTile -> [(MSet,Hand)]
mingkang h t = trySet (map ((take 3).repeat.Just) [t]) h
jiakang :: Hand -> MTile -> [(MSet,Hand)]
jiakang h@(Hand hand call) t = [ (tt,Hand hand ((ht:tt):(call `rmTile` tt)))| tt<-call, let ht = head tt, let ts = (t:hand), ht `elem` ts]

tryTiles :: [Maybe MTile] -> MSet -> [(MSet,MSet)]
tryTiles tl ts = maybeToList $ do
    tt <- sequence tl
    guard $ all (`elem` ts) tt
    return (tt,foldl rmTile ts tt)