V2.hs

module Tart.Format.V2
  ( version2Format
  , encodeVersion2
  )
where

import Control.Monad (when)
import Data.Int (Int32)
import qualified Data.Binary as B

import Tart.Canvas
import Tart.Format.Types

data TartFileDataV2 =
    TartFileDataV2 { tartFileDataV2CanvasData  :: [CanvasData]
                   , tartFileDataV2CanvasNames :: [String]
                   , tartFileDataV2CanvasOrder :: [Int]
                   }

tartFileDataV2Magic :: Int32
tartFileDataV2Magic = 0xcafe02

encodeVersion2 :: TartFile -> B.Put
encodeVersion2 = B.put . tartFileToDataV2

version2Format :: TartFileFormat
version2Format =
    BinaryFormatVersion B.get tartFileFromDataV2

instance B.Binary TartFileDataV2 where
    put d = do
        B.put tartFileDataV2Magic
        B.put $ tartFileDataV2CanvasData d
        B.put $ tartFileDataV2CanvasNames d
        B.put $ tartFileDataV2CanvasOrder d
    get = do
        magic <- B.get
        when (magic /= tartFileDataV2Magic) $
            fail "not a valid tart file version 1"

        TartFileDataV2 <$> B.get
                       <*> B.get
                       <*> B.get

tartFileToDataV2 :: TartFile -> TartFileDataV2
tartFileToDataV2 tf =
    TartFileDataV2 (canvasToData <$> tartFileCanvasList tf)
                   (tartFileCanvasNames tf)
                   (tartFileCanvasOrder tf)

tartFileFromDataV2 :: TartFileDataV2 -> IO (Either String TartFile)
tartFileFromDataV2 d = do
    let loadCanvases [] = return $ Right []
        loadCanvases (cd:cds) = do
            result <- canvasFromData cd
            case result of
                Left e -> return $ Left e
                Right c -> do
                    rest <- loadCanvases cds
                    case rest of
                        Left e -> return $ Left e
                        Right cs -> return $ Right $ c : cs

    result <- loadCanvases (tartFileDataV2CanvasData d)
    case result of
        Left s -> return $ Left s
        Right cs -> return $ Right $ TartFile cs (tartFileDataV2CanvasNames d)
                                                 (tartFileDataV2CanvasOrder d)