content: 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
  