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 = TartFileDataV2 -> Put
forall t. Binary t => t -> Put
B.put (TartFileDataV2 -> Put)
-> (TartFile -> TartFileDataV2) -> TartFile -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TartFile -> TartFileDataV2
tartFileToDataV2

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

        [CanvasData] -> [Text] -> [Int] -> TartFileDataV2
TartFileDataV2 ([CanvasData] -> [Text] -> [Int] -> TartFileDataV2)
-> Get [CanvasData] -> Get ([Text] -> [Int] -> TartFileDataV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [CanvasData]
forall t. Binary t => Get t
B.get
                       Get ([Text] -> [Int] -> TartFileDataV2)
-> Get [Text] -> Get ([Int] -> TartFileDataV2)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack ([String] -> [Text]) -> Get [String] -> Get [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [String]
forall t. Binary t => Get t
B.get)
                       Get ([Int] -> TartFileDataV2) -> Get [Int] -> Get TartFileDataV2
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Int]
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 (Canvas -> CanvasData) -> [Canvas] -> [CanvasData]
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 [] = Either String [Canvas] -> IO (Either String [Canvas])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Canvas] -> IO (Either String [Canvas]))
-> Either String [Canvas] -> IO (Either String [Canvas])
forall a b. (a -> b) -> a -> b
$ [Canvas] -> Either String [Canvas]
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 -> Either String [Canvas] -> IO (Either String [Canvas])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Canvas] -> IO (Either String [Canvas]))
-> Either String [Canvas] -> IO (Either String [Canvas])
forall a b. (a -> b) -> a -> b
$ String -> Either String [Canvas]
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 -> Either String [Canvas] -> IO (Either String [Canvas])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Canvas] -> IO (Either String [Canvas]))
-> Either String [Canvas] -> IO (Either String [Canvas])
forall a b. (a -> b) -> a -> b
$ String -> Either String [Canvas]
forall a b. a -> Either a b
Left String
e
                        Right [Canvas]
cs -> Either String [Canvas] -> IO (Either String [Canvas])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Canvas] -> IO (Either String [Canvas]))
-> Either String [Canvas] -> IO (Either String [Canvas])
forall a b. (a -> b) -> a -> b
$ [Canvas] -> Either String [Canvas]
forall a b. b -> Either a b
Right ([Canvas] -> Either String [Canvas])
-> [Canvas] -> Either String [Canvas]
forall a b. (a -> b) -> a -> b
$ Canvas
c Canvas -> [Canvas] -> [Canvas]
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 -> Either String TartFile -> IO (Either String TartFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String TartFile -> IO (Either String TartFile))
-> Either String TartFile -> IO (Either String TartFile)
forall a b. (a -> b) -> a -> b
$ String -> Either String TartFile
forall a b. a -> Either a b
Left String
s
        Right [Canvas]
cs -> Either String TartFile -> IO (Either String TartFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String TartFile -> IO (Either String TartFile))
-> Either String TartFile -> IO (Either String TartFile)
forall a b. (a -> b) -> a -> b
$ TartFile -> Either String TartFile
forall a b. b -> Either a b
Right (TartFile -> Either String TartFile)
-> TartFile -> Either String TartFile
forall a b. (a -> b) -> a -> b
$ [Canvas] -> [Text] -> [Int] -> TartFile
TartFile [Canvas]
cs (TartFileDataV2 -> [Text]
tartFileDataV2CanvasNames TartFileDataV2
d)
                                                 (TartFileDataV2 -> [Int]
tartFileDataV2CanvasOrder TartFileDataV2
d)