module Tart.Format ( TartFile(..) , OutputFormat(..) , TartFilePath , readTartFile , writeTartFile , sortedCanvases , toTartFilepath ) where import Data.Monoid ((<>)) import Data.List (isSuffixOf) import qualified Data.Binary.Put as B import qualified Data.Binary.Get as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.Text.IO as T import Tart.Canvas import Tart.Format.Types import Tart.Format.V0 import Tart.Format.V1 import Tart.Format.V2 data OutputFormat = FormatBinary | FormatAnsiColor | FormatPlain deriving (OutputFormat -> OutputFormat -> Bool (OutputFormat -> OutputFormat -> Bool) -> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: OutputFormat -> OutputFormat -> Bool $c/= :: OutputFormat -> OutputFormat -> Bool == :: OutputFormat -> OutputFormat -> Bool $c== :: OutputFormat -> OutputFormat -> Bool Eq, Int -> OutputFormat -> ShowS [OutputFormat] -> ShowS OutputFormat -> String (Int -> OutputFormat -> ShowS) -> (OutputFormat -> String) -> ([OutputFormat] -> ShowS) -> Show OutputFormat forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [OutputFormat] -> ShowS $cshowList :: [OutputFormat] -> ShowS show :: OutputFormat -> String $cshow :: OutputFormat -> String showsPrec :: Int -> OutputFormat -> ShowS $cshowsPrec :: Int -> OutputFormat -> ShowS Show, ReadPrec [OutputFormat] ReadPrec OutputFormat Int -> ReadS OutputFormat ReadS [OutputFormat] (Int -> ReadS OutputFormat) -> ReadS [OutputFormat] -> ReadPrec OutputFormat -> ReadPrec [OutputFormat] -> Read OutputFormat forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [OutputFormat] $creadListPrec :: ReadPrec [OutputFormat] readPrec :: ReadPrec OutputFormat $creadPrec :: ReadPrec OutputFormat readList :: ReadS [OutputFormat] $creadList :: ReadS [OutputFormat] readsPrec :: Int -> ReadS OutputFormat $creadsPrec :: Int -> ReadS OutputFormat Read) formats :: [TartFileFormat] formats :: [TartFileFormat] formats = [ TartFileFormat version2Format , TartFileFormat version1Format , TartFileFormat version0Format ] newtype TartFilePath = TartFilePath FilePath tartFilenameExtension :: String tartFilenameExtension :: String tartFilenameExtension = String ".tart" toTartFilepath :: FilePath -> TartFilePath toTartFilepath :: String -> TartFilePath toTartFilepath String p = if String tartFilenameExtension String -> String -> Bool forall a. Eq a => [a] -> [a] -> Bool `isSuffixOf` String p then String -> TartFilePath TartFilePath (String -> TartFilePath) -> String -> TartFilePath forall a b. (a -> b) -> a -> b $ Int -> ShowS forall a. Int -> [a] -> [a] take (String -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String p Int -> Int -> Int forall a. Num a => a -> a -> a - String -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String tartFilenameExtension) String p else String -> TartFilePath TartFilePath String p readTartFile :: TartFilePath -> IO (Either String TartFile) readTartFile :: TartFilePath -> IO (Either String TartFile) readTartFile (TartFilePath String path) = do ByteString bs <- String -> IO ByteString BS.readFile (String -> IO ByteString) -> String -> IO ByteString forall a b. (a -> b) -> a -> b $ String path String -> ShowS forall a. Semigroup a => a -> a -> a <> String tartFilenameExtension ByteString -> String -> [TartFileFormat] -> IO (Either String TartFile) readTartFile' (ByteString -> ByteString BSL.fromStrict ByteString bs) String path [TartFileFormat] formats readTartFile' :: BSL.ByteString -> FilePath -> [TartFileFormat] -> IO (Either String TartFile) readTartFile' :: ByteString -> String -> [TartFileFormat] -> IO (Either String TartFile) readTartFile' ByteString _ String path [] = 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 -> Either String TartFile) -> String -> Either String TartFile forall a b. (a -> b) -> a -> b $ String path String -> ShowS forall a. Semigroup a => a -> a -> a <> String ": could not load file" readTartFile' ByteString bs String path ((BinaryFormatVersion Get a parser a -> IO (Either String TartFile) converter):[TartFileFormat] fmts) = do let tryNextFormat :: IO (Either String TartFile) tryNextFormat = ByteString -> String -> [TartFileFormat] -> IO (Either String TartFile) readTartFile' ByteString bs String path [TartFileFormat] fmts case Get a -> ByteString -> Either (ByteString, ByteOffset, String) (ByteString, ByteOffset, a) forall a. Get a -> ByteString -> Either (ByteString, ByteOffset, String) (ByteString, ByteOffset, a) B.runGetOrFail Get a parser ByteString bs of Left (ByteString, ByteOffset, String) _ -> IO (Either String TartFile) tryNextFormat Right (ByteString remaining, ByteOffset _, a d) -> case ByteString -> Bool BSL.null ByteString remaining of Bool False -> IO (Either String TartFile) tryNextFormat Bool True -> do Either String TartFile result <- a -> IO (Either String TartFile) converter a d case Either String TartFile result of Left String _ -> IO (Either String TartFile) tryNextFormat Right TartFile tf -> 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 tf writeTartFile :: OutputFormat -> TartFile -> TartFilePath -> IO () writeTartFile :: OutputFormat -> TartFile -> TartFilePath -> IO () writeTartFile OutputFormat format = case OutputFormat format of OutputFormat FormatPlain -> Bool -> TartFile -> TartFilePath -> IO () writeTartFilePretty Bool False OutputFormat FormatAnsiColor -> Bool -> TartFile -> TartFilePath -> IO () writeTartFilePretty Bool True OutputFormat FormatBinary -> TartFile -> TartFilePath -> IO () writeTartFileBinary sortedCanvases :: [Int] -> [Canvas] -> [Canvas] sortedCanvases :: [Int] -> [Canvas] -> [Canvas] sortedCanvases [Int] order [Canvas] cs = [ [Canvas] cs [Canvas] -> Int -> Canvas forall a. [a] -> Int -> a !! Int i | Int i <- [Int] order ] tartFileCanvasesSorted :: TartFile -> [Canvas] tartFileCanvasesSorted :: TartFile -> [Canvas] tartFileCanvasesSorted TartFile tf = [Int] -> [Canvas] -> [Canvas] sortedCanvases (TartFile -> [Int] tartFileCanvasOrder TartFile tf) (TartFile -> [Canvas] tartFileCanvasList TartFile tf) writeTartFilePretty :: Bool -> TartFile -> TartFilePath -> IO () writeTartFilePretty :: Bool -> TartFile -> TartFilePath -> IO () writeTartFilePretty Bool color TartFile tf (TartFilePath String path) = let ext :: String ext = if Bool color then String ".color.txt" else String ".plain.txt" fn :: String fn = String path String -> ShowS forall a. Semigroup a => a -> a -> a <> String ext in String -> Text -> IO () T.writeFile String fn (Text -> IO ()) -> Text -> IO () forall a b. (a -> b) -> a -> b $ Bool -> [Canvas] -> Text prettyPrintCanvas Bool color ([Canvas] -> Text) -> [Canvas] -> Text forall a b. (a -> b) -> a -> b $ TartFile -> [Canvas] tartFileCanvasesSorted TartFile tf writeTartFileBinary :: TartFile -> TartFilePath -> IO () writeTartFileBinary :: TartFile -> TartFilePath -> IO () writeTartFileBinary TartFile tf (TartFilePath String path) = let fn :: String fn = String path String -> ShowS forall a. Semigroup a => a -> a -> a <> String tartFilenameExtension in String -> ByteString -> IO () BS.writeFile String fn (ByteString -> IO ()) -> ByteString -> IO () forall a b. (a -> b) -> a -> b $ ByteString -> ByteString BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString forall a b. (a -> b) -> a -> b $ Put -> ByteString B.runPut (Put -> ByteString) -> Put -> ByteString forall a b. (a -> b) -> a -> b $ TartFile -> Put latestVersionEncoder TartFile tf latestVersionEncoder :: TartFile -> B.Put latestVersionEncoder :: TartFile -> Put latestVersionEncoder = TartFile -> Put encodeVersion2