module Tart.Format.V1
  ( version1Format
  , encodeVersion1
  )
where

import qualified Data.Binary as B
import qualified Data.Text as T

import Tart.Canvas
import Tart.Format.Types

data TartFileDataV1 =
    TartFileDataV1 { TartFileDataV1 -> [CanvasData]
tartFileDataV1CanvasData  :: [CanvasData]
                   , TartFileDataV1 -> [Text]
tartFileDataV1CanvasNames :: [T.Text]
                   , TartFileDataV1 -> [Int]
tartFileDataV1CanvasOrder :: [Int]
                   }

encodeVersion1 :: TartFile -> B.Put
encodeVersion1 :: TartFile -> Put
encodeVersion1 = forall t. Binary t => t -> Put
B.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. TartFile -> TartFileDataV1
tartFileToDataV1

version1Format :: TartFileFormat
version1Format :: TartFileFormat
version1Format =
    forall a.
Get a -> (a -> IO (Either String TartFile)) -> TartFileFormat
BinaryFormatVersion forall t. Binary t => Get t
B.get TartFileDataV1 -> IO (Either String TartFile)
tartFileFromDataV1

instance B.Binary TartFileDataV1 where
    put :: TartFileDataV1 -> Put
put TartFileDataV1
d = do
        forall t. Binary t => t -> Put
B.put forall a b. (a -> b) -> a -> b
$ TartFileDataV1 -> [CanvasData]
tartFileDataV1CanvasData TartFileDataV1
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
<$> TartFileDataV1 -> [Text]
tartFileDataV1CanvasNames TartFileDataV1
d
        forall t. Binary t => t -> Put
B.put forall a b. (a -> b) -> a -> b
$ TartFileDataV1 -> [Int]
tartFileDataV1CanvasOrder TartFileDataV1
d
    get :: Get TartFileDataV1
get = do
        [CanvasData] -> [Text] -> [Int] -> TartFileDataV1
TartFileDataV1 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

tartFileToDataV1 :: TartFile -> TartFileDataV1
tartFileToDataV1 :: TartFile -> TartFileDataV1
tartFileToDataV1 TartFile
tf =
    [CanvasData] -> [Text] -> [Int] -> TartFileDataV1
TartFileDataV1 (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)

tartFileFromDataV1 :: TartFileDataV1 -> IO (Either String TartFile)
tartFileFromDataV1 :: TartFileDataV1 -> IO (Either String TartFile)
tartFileFromDataV1 TartFileDataV1
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 (TartFileDataV1 -> [CanvasData]
tartFileDataV1CanvasData TartFileDataV1
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 (TartFileDataV1 -> [Text]
tartFileDataV1CanvasNames TartFileDataV1
d)
                                                 (TartFileDataV1 -> [Int]
tartFileDataV1CanvasOrder TartFileDataV1
d)