content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Data.Hoodle.Simple.V0_2_2 where
  
  import Data.ByteString.Char8 (ByteString, pack)
  import Data.Hoodle.Util (fst3, snd3)
  import qualified Data.Serialize as SE
  import Data.Strict.Tuple (Pair (..))
  import Data.UUID.V4 (nextRandom)
  import Lens.Micro (Lens', lens, set)
  import Prelude hiding (curry, fst, putStrLn, snd, uncurry)
  
  -- |
  type Title = ByteString
  
  -- | wrapper of object embeddable in Layer
  data Item
    = ItemStroke Stroke
    | ItemImage Image
    | ItemSVG SVG
    | ItemLink Link
    deriving (Show, Eq, Ord)
  
  -- | Pen stroke item
  data Stroke
    = Stroke
        { stroke_tool :: !ByteString,
          stroke_color :: !ByteString,
          stroke_width :: !Double,
          stroke_data :: ![Pair Double Double]
        }
    | VWStroke
        { stroke_tool :: ByteString,
          stroke_color :: ByteString,
          stroke_vwdata :: [(Double, Double, Double)]
        }
    deriving (Show, Eq, Ord)
  
  -- | Image item
  data Image = Image
    { img_src :: ByteString,
      img_pos :: (Double, Double),
      img_dim :: !Dimension
    }
    deriving (Show, Eq, Ord)
  
  data SVG = SVG
    { svg_text :: Maybe ByteString,
      svg_command :: Maybe ByteString,
      svg_render :: ByteString,
      svg_pos :: (Double, Double),
      svg_dim :: !Dimension
    }
    deriving (Show, Eq, Ord)
  
  data Link
    = Link
        { link_id :: ByteString,
          link_type :: ByteString,
          link_location :: ByteString,
          link_text :: Maybe ByteString,
          link_command :: Maybe ByteString,
          link_render :: ByteString,
          link_pos :: (Double, Double),
          link_dim :: !Dimension
        }
    | LinkDocID
        { link_id :: ByteString,
          link_linkeddocid :: ByteString,
          link_location :: ByteString,
          link_text :: Maybe ByteString,
          link_command :: Maybe ByteString,
          link_render :: ByteString,
          link_pos :: (Double, Double),
          link_dim :: !Dimension
        }
    deriving (Show, Eq, Ord)
  
  -- |
  instance SE.Serialize Stroke where
    put Stroke {..} =
      SE.putWord8 0
        >> SE.put stroke_tool
        >> SE.put stroke_color
        >> SE.put stroke_width
        >> SE.put stroke_data
    put VWStroke {..} =
      SE.putWord8 1
        >> SE.put stroke_tool
        >> SE.put stroke_color
        >> SE.put stroke_vwdata
    get = do
      tag <- SE.getWord8
      case tag of
        0 -> Stroke <$> SE.get <*> SE.get <*> SE.get <*> SE.get
        1 -> VWStroke <$> SE.get <*> SE.get <*> SE.get
        _ -> fail "err in Stroke parsing"
  
  -- |
  instance SE.Serialize Image where
    put Image {..} =
      SE.put img_src
        >> SE.put img_pos
        >> SE.put img_dim
    get = Image <$> SE.get <*> SE.get <*> SE.get
  
  -- |
  instance SE.Serialize SVG where
    put SVG {..} =
      SE.put svg_text
        >> SE.put svg_command
        >> SE.put svg_render
        >> SE.put svg_pos
        >> SE.put svg_dim
    get = SVG <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get
  
  -- |
  instance SE.Serialize Link where
    put Link {..} =
      SE.putWord8 0
        >> SE.put link_id
        >> SE.put link_type
        >> SE.put link_location
        >> SE.put link_text
        >> SE.put link_command
        >> SE.put link_render
        >> SE.put link_pos
        >> SE.put link_dim
    put LinkDocID {..} =
      SE.putWord8 1
        >> SE.put link_id
        >> SE.put link_linkeddocid
        >> SE.put link_location
        >> SE.put link_text
        >> SE.put link_command
        >> SE.put link_render
        >> SE.put link_pos
        >> SE.put link_dim
  
    get = do
      tag <- SE.getWord8
      case tag of
        0 ->
          Link <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get
            <*> SE.get
            <*> SE.get
            <*> SE.get
        1 ->
          LinkDocID <$> SE.get <*> SE.get <*> SE.get <*> SE.get <*> SE.get
            <*> SE.get
            <*> SE.get
            <*> SE.get
        _ -> fail "err in Link parsing"
  
  -- |
  instance SE.Serialize Item where
    put (ItemStroke str) =
      SE.putWord8 0
        >> SE.put str
    put (ItemImage img) =
      SE.putWord8 1
        >> SE.put img
    put (ItemSVG svg) =
      SE.putWord8 2
        >> SE.put svg
    put (ItemLink lnk) =
      SE.putWord8 3
        >> SE.put lnk
    get = do
      tag <- SE.getWord8
      case tag of
        0 -> ItemStroke <$> SE.get
        1 -> ItemImage <$> SE.get
        2 -> ItemSVG <$> SE.get
        3 -> ItemLink <$> SE.get
        _ -> fail "err in Item parsing"
  
  -- | Orphan instance for Pair
  instance (SE.Serialize a, SE.Serialize b) => SE.Serialize (Pair a b) where
    put (x :!: y) =
      SE.put x
        >> SE.put y
    get = (:!:) <$> SE.get <*> SE.get
  
  -- |
  data Dimension = Dim {dim_width :: !Double, dim_height :: !Double}
    deriving (Show, Eq, Ord)
  
  -- |
  instance SE.Serialize Dimension where
    put (Dim w h) = SE.put w >> SE.put h
    get = Dim <$> SE.get <*> SE.get
  
  -- |
  data Background
    = Background
        { bkg_type :: !ByteString,
          bkg_color :: !ByteString,
          bkg_style :: !ByteString
        }
    | BackgroundPdf
        { bkg_type :: ByteString,
          bkg_domain :: Maybe ByteString,
          bkg_filename :: Maybe ByteString,
          bkg_pageno :: Int
        }
    | BackgroundEmbedPdf
        { bkg_type :: ByteString,
          bkg_pageno :: Int
        }
    deriving (Show)
  
  -- |
  data Revision
    = Revision
        { _revmd5 :: !ByteString,
          _revtxt :: !ByteString
        }
    | RevisionInk
        { _revmd5 :: !ByteString,
          _revink :: [Stroke]
        }
    deriving (Show)
  
  -- |
  data Hoodle = Hoodle
    { hoodle_id :: ByteString,
      hoodle_title :: !Title,
      hoodle_revisions :: [Revision],
      hoodle_embeddedpdf :: Maybe ByteString,
      hoodle_pages :: ![Page]
    }
    deriving (Show)
  
  -- |
  data Page = Page
    { page_dim :: !Dimension,
      page_bkg :: !Background,
      page_layers :: ![Layer]
    }
    deriving (Show)
  
  -- |
  newtype Layer = Layer {layer_items :: [Item]}
    deriving (Show)
  
  -- |
  getXYtuples :: Stroke -> [(Double, Double)]
  getXYtuples (Stroke _t _c _w d) = map (\(x :!: y) -> (x, y)) d
  getXYtuples (VWStroke _t _c d) = map ((,) <$> fst3 <*> snd3) d
  
  ----------------------------
  -- Lenses
  ----------------------------
  
  -- |
  tool :: Lens' Stroke ByteString
  tool = lens stroke_tool (\f a -> f {stroke_tool = a})
  
  -- |
  color :: Lens' Stroke ByteString
  color = lens stroke_color (\f a -> f {stroke_color = a})
  
  -- |
  hoodleID :: Lens' Hoodle ByteString
  hoodleID = lens hoodle_id (\f a -> f {hoodle_id = a})
  
  -- |
  title :: Lens' Hoodle Title
  title = lens hoodle_title (\f a -> f {hoodle_title = a})
  
  -- |
  revisions :: Lens' Hoodle [Revision]
  revisions = lens hoodle_revisions (\f a -> f {hoodle_revisions = a})
  
  -- |
  revmd5 :: Lens' Revision ByteString
  revmd5 = lens _revmd5 (\f a -> f {_revmd5 = a})
  
  -- |
  embeddedPdf :: Lens' Hoodle (Maybe ByteString)
  embeddedPdf = lens hoodle_embeddedpdf (\f a -> f {hoodle_embeddedpdf = a})
  
  -- |
  pages :: Lens' Hoodle [Page]
  pages = lens hoodle_pages (\f a -> f {hoodle_pages = a})
  
  -- |
  dimension :: Lens' Page Dimension
  dimension = lens page_dim (\f a -> f {page_dim = a})
  
  -- |
  background :: Lens' Page Background
  background = lens page_bkg (\f a -> f {page_bkg = a})
  
  -- |
  layers :: Lens' Page [Layer]
  layers = lens page_layers (\f a -> f {page_layers = a})
  
  -- |
  items :: Lens' Layer [Item]
  items = lens layer_items (\f a -> f {layer_items = a})
  
  --------------------------
  -- empty objects
  --------------------------
  
  -- |
  emptyHoodle :: IO Hoodle
  emptyHoodle = do
    uuid <- nextRandom
    return $ Hoodle ((pack . show) uuid) "" [] Nothing []
  
  -- |
  emptyLayer :: Layer
  emptyLayer = Layer {layer_items = []}
  
  -- |
  emptyStroke :: Stroke
  emptyStroke = Stroke "pen" "black" 1.4 []
  
  -- |
  defaultBackground :: Background
  defaultBackground =
    Background
      { bkg_type = "solid",
        bkg_color = "white",
        bkg_style = "lined"
      }
  
  -- |
  defaultPage :: Page
  defaultPage =
    Page
      { page_dim = Dim 612.0 792.0,
        page_bkg = defaultBackground,
        page_layers = [emptyLayer]
      }
  
  -- |
  defaultHoodle :: IO Hoodle
  defaultHoodle =
    set title "untitled" . set embeddedPdf Nothing . set pages [defaultPage]
      <$> emptyHoodle
  
  -- |
  newPageFromOld :: Page -> Page
  newPageFromOld page =
    Page
      { page_dim = page_dim page,
        page_bkg = page_bkg page,
        page_layers = [emptyLayer]
      }
  