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

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

import Tart.Canvas
import Tart.Format.Types

data TartFileDataV2 =
    TartFileDataV2 { TartFileDataV2 -> [CanvasData]
tartFileDataV2CanvasData  :: [CanvasData]
                   , TartFileDataV2 -> [Text]
tartFileDataV2CanvasNames :: [T.Text]
                   , TartFileDataV2 -> [Int]
tartFileDataV2CanvasOrder :: [Int]
                   }

tartFileDataV2Magic :: Int32
tartFileDataV2Magic :: Int32
tartFileDataV2Magic = Int32
0xcafe02

encodeVersion2 :: TartFile -> B.Put
encodeVersion2 :: TartFile -> Put
encodeVersion2 = forall t. Binary t => t -> Put
B.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. TartFile -> TartFileDataV2
tartFileToDataV2

version2Format :: TartFileFormat
version2Format :: TartFileFormat
version2Format =
    forall a.
Get a -> (a -> IO (Either String TartFile)) -> TartFileFormat
BinaryFormatVersion forall t. Binary t => Get t
B.get TartFileDataV2 -> IO (Either String TartFile)
tartFileFromDataV2

instance B.Binary TartFileDataV2 where
    put :: TartFileDataV2 -> Put
put TartFileDataV2
d = do
        forall t. Binary t => t -> Put
B.put Int32
tartFileDataV2Magic
        forall t. Binary t => t -> Put
B.put forall a b. (a -> b) -> a -> b
$ TartFileDataV2 -> [CanvasData]
tartFileDataV2CanvasData TartFileDataV2
d
        forall t. Binary t => t -> Put
B.put forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TartFileDataV2 -> [Text]
tartFileDataV2CanvasNames TartFileDataV2
d
        forall t. Binary t => t -> Put
B.put forall a b. (a -> b) -> a -> b
$ TartFileDataV2 -> [Int]
tartFileDataV2CanvasOrder TartFileDataV2
d
    get :: Get TartFileDataV2
get = do
        Int32
magic <- forall t. Binary t => Get t
B.get
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
magic forall a. Eq a => a -> a -> Bool
/= Int32
tartFileDataV2Magic) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid tart file version 1"

        [CanvasData] -> [Text] -> [Int] -> TartFileDataV2
TartFileDataV2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
B.get
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
B.get)
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall t. Binary t => Get t
B.get

tartFileToDataV2 :: TartFile -> TartFileDataV2
tartFileToDataV2 :: TartFile -> TartFileDataV2
tartFileToDataV2 TartFile
tf =
    [CanvasData] -> [Text] -> [Int] -> TartFileDataV2
TartFileDataV2 (Canvas -> CanvasData
canvasToData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TartFile -> [Canvas]
tartFileCanvasList TartFile
tf)
                   (TartFile -> [Text]
tartFileCanvasNames TartFile
tf)
                   (TartFile -> [Int]
tartFileCanvasOrder TartFile
tf)

tartFileFromDataV2 :: TartFileDataV2 -> IO (Either String TartFile)
tartFileFromDataV2 :: TartFileDataV2 -> IO (Either String TartFile)
tartFileFromDataV2 TartFileDataV2
d = do
    let loadCanvases :: [CanvasData] -> IO (Either String [Canvas])
loadCanvases [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right []
        loadCanvases (CanvasData
cd:[CanvasData]
cds) = do
            Either String Canvas
result <- CanvasData -> IO (Either String Canvas)
canvasFromData CanvasData
cd
            case Either String Canvas
result of
                Left String
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
e
                Right Canvas
c -> do
                    Either String [Canvas]
rest <- [CanvasData] -> IO (Either String [Canvas])
loadCanvases [CanvasData]
cds
                    case Either String [Canvas]
rest of
                        Left String
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
e
                        Right [Canvas]
cs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Canvas
c forall a. a -> [a] -> [a]
: [Canvas]
cs

    Either String [Canvas]
result <- [CanvasData] -> IO (Either String [Canvas])
loadCanvases (TartFileDataV2 -> [CanvasData]
tartFileDataV2CanvasData TartFileDataV2
d)
    case Either String [Canvas]
result of
        Left String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
s
        Right [Canvas]
cs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Canvas] -> [Text] -> [Int] -> TartFile
TartFile [Canvas]
cs (TartFileDataV2 -> [Text]
tartFileDataV2CanvasNames TartFileDataV2
d)
                                                 (TartFileDataV2 -> [Int]
tartFileDataV2CanvasOrder TartFileDataV2
d)