introduce stack build system and restructure code

src/Skat/Pile.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Skat.Pile where
+
+import Data.List
+import Data.Aeson
+import Control.Exception
+
+import Skat.Card
+import Skat.Utils
+
+data Team = Team | Single
+            deriving (Show, Eq, Ord, Enum)
+
+data CardS p = CardS { getCard :: Card
+                     , getPile :: p }
+               deriving (Show, Eq, Ord)
+
+instance Countable (CardS p) Int where
+    count = count . getCard
+
+instance ToJSON p => ToJSON (CardS p) where
+    toJSON (CardS card pile) =
+        object ["card" .= card, "pile" .= pile]
+
+data Hand = Hand1 | Hand2 | Hand3
+            deriving (Show, Eq, Ord)
+
+next :: Hand -> Hand
+next Hand1 = Hand2
+next Hand2 = Hand3
+next Hand3 = Hand1
+
+prev :: Hand -> Hand
+prev Hand1 = Hand3
+prev Hand2 = Hand1
+prev Hand3 = Hand2
+
+data Played = Table Hand
+            | Won Hand Team
+              deriving (Show, Eq, Ord)
+
+instance ToJSON Played where
+    toJSON (Table hand) =
+        object ["state" .= ("table" :: String), "played_by" .= show hand]
+    toJSON (Won hand team) =
+        object ["state" .= ("won" :: String), "played_by" .= show hand, "won_by" .= show team]
+
+data SkatP = SkatP
+             deriving (Show, Eq, Ord)
+
+data Piles = Piles { hands :: [CardS Hand]
+                   , played :: [CardS Played]
+                   , skat :: [CardS SkatP] }
+             deriving (Show, Eq, Ord)
+
+instance Countable Piles (Int, Int) where
+    count ps = (sgl, tm)
+        where sgl = count (skatCards ps) + count (wonCards Single ps)
+              tm = count (wonCards Team ps)
+
+origin :: CardS Played -> Hand
+origin (CardS _ (Table hand)) = hand
+origin (CardS _ (Won hand _)) = hand
+
+originOfCard :: Card -> Piles -> Maybe Hand
+originOfCard card (Piles _ pld _) = origin <$> find ((==card) . getCard) pld
+
+playCard :: Card -> Piles -> Piles
+playCard card (Piles hs pld skt) = Piles hs' (ca : pld) skt
+    where (CardS _ hand, hs') = remove ((==card) . getCard) hs
+          ca = CardS card (Table hand)
+
+winCard :: Team -> CardS Played -> CardS Played
+winCard team (CardS card (Table hand)) = CardS card (Won hand team)
+winCard team c                         = c
+
+wonCards :: Team -> Piles -> [Card]
+wonCards team (Piles _ pld _) = filterMap (f . getPile) getCard pld
+    where f (Won _ tm) = tm == team
+          f _          = False
+
+cleanTable :: Team -> Piles -> Piles
+cleanTable winner ps@(Piles hs pld skt) = Piles hs pld' skt
+    where table = tableCards ps
+          pld' = map (winCard winner) pld
+
+tableCards :: Piles -> [Card]
+tableCards (Piles _ pld _) = filterMap (f . getPile) getCard pld
+    where f (Table _) = True
+          f _         = False
+
+tableCardsS :: Piles -> [CardS Played]
+tableCardsS (Piles _ pld _) = filter (f . getPile) pld
+    where f (Table _) = True
+          f _         = False
+
+handCards :: Hand -> Piles -> [Card]
+handCards hand (Piles hs _ _) = filterMap ((==hand) . getPile) getCard hs
+
+skatCards :: Piles -> [Card]
+skatCards (Piles _ _ skat) = map getCard skat
+
+putAt :: p -> Card -> CardS p
+putAt = flip CardS
+
+distribute :: [Card] -> Piles
+distribute cards = Piles hands [] (map (putAt SkatP) skt)
+    where round1 = chunksOf 3 (take 9 cards)
+          skt = take 2 $ drop 9 cards
+          round2 = chunksOf 4 (take 12 $ drop 11 cards)
+          round3 = chunksOf 3 (take 9 $ drop 23 cards)
+          hand1 = concatMap (!! 0) [round1, round2, round3]
+          hand2 = concatMap (!! 1) [round1, round2, round3]
+          hand3 = concatMap (!! 2) [round1, round2, round3]
+          hands = map (putAt Hand1) hand1
+            ++ map (putAt Hand2) hand2
+            ++ map (putAt Hand3) hand3