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 (Eq, Show, Read) formats :: [TartFileFormat] formats = [ version2Format , version1Format , version0Format ] newtype TartFilePath = TartFilePath FilePath tartFilenameExtension :: String tartFilenameExtension = ".tart" toTartFilepath :: FilePath -> TartFilePath toTartFilepath p = if tartFilenameExtension `isSuffixOf` p then TartFilePath $ take (length p - length tartFilenameExtension) p else TartFilePath p readTartFile :: TartFilePath -> IO (Either String TartFile) readTartFile (TartFilePath path) = do bs <- BS.readFile $ path <> tartFilenameExtension readTartFile' (BSL.fromStrict bs) path formats readTartFile' :: BSL.ByteString -> FilePath -> [TartFileFormat] -> IO (Either String TartFile) readTartFile' _ path [] = return $ Left $ path <> ": could not load file" readTartFile' bs path ((BinaryFormatVersion parser converter):fmts) = do let tryNextFormat = readTartFile' bs path fmts case B.runGetOrFail parser bs of Left _ -> tryNextFormat Right (remaining, _, d) -> case BSL.null remaining of False -> tryNextFormat True -> do result <- converter d case result of Left _ -> tryNextFormat Right tf -> return $ Right tf writeTartFile :: OutputFormat -> TartFile -> TartFilePath -> IO () writeTartFile format = case format of FormatPlain -> writeTartFilePretty False FormatAnsiColor -> writeTartFilePretty True FormatBinary -> writeTartFileBinary sortedCanvases :: [Int] -> [Canvas] -> [Canvas] sortedCanvases order cs = [ cs !! i | i <- order ] tartFileCanvasesSorted :: TartFile -> [Canvas] tartFileCanvasesSorted tf = sortedCanvases (tartFileCanvasOrder tf) (tartFileCanvasList tf) writeTartFilePretty :: Bool -> TartFile -> TartFilePath -> IO () writeTartFilePretty color tf (TartFilePath path) = let ext = if color then ".color.txt" else ".plain.txt" fn = path <> ext in T.writeFile fn $ prettyPrintCanvas color $ tartFileCanvasesSorted tf writeTartFileBinary :: TartFile -> TartFilePath -> IO () writeTartFileBinary tf (TartFilePath path) = let fn = path <> tartFilenameExtension in BS.writeFile fn $ BSL.toStrict $ B.runPut $ latestVersionEncoder tf latestVersionEncoder :: TartFile -> B.Put latestVersionEncoder = encodeVersion2