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)