{-# LANGUAGE OverloadedStrings #-}
module Data.Comic (
    Hint(..), Position(..), Font(..), FontName, FontSize, RGBA, Comic(..), Panel(..)
  , HintSize, ImageName
  , ComicDelta(..)
  , blackRGBA
  ) where

import Control.Monad
import Control.Applicative
import Data.Text (Text)
import qualified Data.Aeson as JS
import qualified Data.Aeson.Types as JS
import Data.Aeson (ToJSON(..), FromJSON(..), (.:))
import Data.Comic.Types

data Hint =
    ZoneHint {
        _hintTxt :: Text
      }
  | ClickZoneHint {
        _hintLocal :: Maybe (Position, HintSize)
      , _hintLink :: Text
      }
  | HoverHint {
        -- Where the hint is, in relation to the slice it is in.
        _hintPos :: Position
        -- How far off the target they'll get the hint on hover and how large we highlight.
      , _hintSize :: HintSize
        -- What the actual hint is.
      , _hintTxt :: Text
      }
  deriving (Show, Eq, Ord)

instance ToJSON Hint where
  toJSON (ZoneHint t) = JS.object [("txt",  toJSON t)]
  toJSON (ClickZoneHint ml l) = JS.object $ [ ("href", toJSON l) ] ++
                                maybe [] (\(p, s) -> [("size", toJSON s), ("pos", toJSON p)]) ml
  toJSON (HoverHint p s t) =
    JS.object
    [ ("pos", toJSON p)
    , ("size", toJSON s)
    , ("txt", toJSON t) ]

instance FromJSON Hint where
  parseJSON (JS.Object v) =
    (ClickZoneHint <$> (((\s p -> Just (p, s)) <$> v .: "size" <*> v .: "pos") <|> pure Nothing) <*> v .: "href") <|>
    (HoverHint <$> v .: "pos" <*> v .: "size" <*> v .: "txt") <|>
    (ZoneHint <$> v .: "txt")
  parseJSON _ = mzero

data Panel =
  Panel {
    -- List of panel parts, left to right.
      _panelBackground   :: ImageName
    -- Zone hints.
    , _panelHints    :: [Hint]
    , _panelTexts    :: [((Position, Position), Font, Text)]
    , _panelOverlays :: [(Position, ImageName)]
    }
  deriving (Show, Eq, Ord)

text2json :: ((Position, Position), Font, Text) -> JS.Value
text2json ((tl, br), Font fn fs c, t) =
  JS.object [ ("tl", toJSON tl), ("br", toJSON br)
            , ("font", toJSON fn), ("size", toJSON fs), ("color", toJSON c)
            , ("txt", toJSON t) ]

json2text :: JS.Value -> JS.Parser ((Position, Position), Font, Text)
json2text (JS.Object v1) =
        (\tl br fn fs c t -> ((tl, br), Font fn fs c, t)) <$>
          v1 .: "tl" <*> v1 .: "br" <*>
          v1 .: "font" <*> v1 .: "size" <*> v1 .: "color" <*>
          v1 .: "txt"
json2text _ = mzero

instance ToJSON Panel where
  toJSON (Panel ss hs txts overs) =
    JS.object $ [
        ("background", toJSON ss)
      , ("hints", toJSON hs)
      , ("texts", toJSON $ map text2json txts)
      , ("overlays", toJSON $ map (\(p, i) ->
                                    JS.object [ ("tl", toJSON p)
                                              , ("img", toJSON i) ]) overs)
      ]

instance FromJSON Panel where
  parseJSON (JS.Object v) = 
      Panel <$> 
        v .: "background" <*>
        v .: "hints" <*>
        (v .: "texts" >>= mapM json2text) <*>
        (v .: "overlays" >>= mapM parseOver)
    where
      parseOver (JS.Object v1) = (,) <$> v1 .: "tl" <*> v1 .: "img"
      parseOver _ = mzero
  parseJSON _ = mzero

data Comic =
  Comic {
      _comicPanels :: [Panel]
    , _comicAlt :: Text
      -- This needs something more to tell us how to layout the panels.
    , _comicPad    :: Int
    }
  deriving (Show, Eq, Ord)

instance ToJSON Comic where
  toJSON (Comic ps alt pad) = JS.object [("panels", toJSON ps), ("pad", toJSON pad), ("alt", toJSON alt)]

instance FromJSON Comic where
  parseJSON (JS.Object v) =
    Comic <$> v .: "panels" <*> v .: "alt" <*> v .: "pad"
  parseJSON _ = mzero

data ComicDelta =
   CompleteComic Comic
 | AppendPanels [Panel]
 | AddTexts [((Position, Position), Font, Text)]
 deriving (Show, Eq)

instance ToJSON ComicDelta where
  toJSON (CompleteComic c) = JS.object [("complete", toJSON c)]
  toJSON (AppendPanels ps) = JS.object [("append_panels", toJSON ps)]
  toJSON (AddTexts txts) = JS.object [("add_texts", toJSON $ map text2json txts)]

instance FromJSON ComicDelta where
  parseJSON (JS.Object v) =
    (CompleteComic <$> v .: "complete") <|>
    (AppendPanels <$> v .: "append_panels") <|>
    (AddTexts <$> (v .: "add_texts" >>= mapM json2text)) 
  parseJSON _ = mzero