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)