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