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)