-- | A collection of types and utilities for dealing with
-- TI Link backup files.
module Data.TI85.File (
    -- * Re-exported modules
    module Data.TI85.File.Variable,
    module Data.TI85.File.Backup,
    -- * Types
    TIHeader(..),
    TIFileData(..),
    TIFile(..)
    ) where

import Data.ByteString
import Data.Word

import Data.TI85.File.Variable
import Data.TI85.File.Backup

-- | The TI-85 header is common between backup files
-- and variable files.
--
-- +--------+---+---------------------------------+
-- | 8 Byte | 3 | 42 Byte                         |
-- +========+===+=================================+
-- |**TI85**|xyz| Comment                         |
-- +--------+---+---------------------------------+
--
-- where @xyz@ is always @0x1a,0x0c,0x00@.
data TIHeader = TIHeader {
    TIHeader -> ByteString
hdrSig :: ByteString, -- 8 bytes
    TIHeader -> ByteString
hdrSig2 :: ByteString, -- 3 bytes
    TIHeader -> ByteString
hdrComment :: ByteString, -- 42 bytes
    TIHeader -> Word16
hdrDataLen :: Word16
    } deriving Int -> TIHeader -> ShowS
[TIHeader] -> ShowS
TIHeader -> String
(Int -> TIHeader -> ShowS)
-> (TIHeader -> String) -> ([TIHeader] -> ShowS) -> Show TIHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIHeader -> ShowS
showsPrec :: Int -> TIHeader -> ShowS
$cshow :: TIHeader -> String
show :: TIHeader -> String
$cshowList :: [TIHeader] -> ShowS
showList :: [TIHeader] -> ShowS
Show

-- | There are two possible file formats
--
-- - Variable files contain one or more variables,
--   encoded in a variable-specific way.
-- - Backup files contain memory dumps, which also
--   include variable data in a raw form.
data TIFileData = BackupData TIBackupData
    | VariableData TIVarData
    deriving Int -> TIFileData -> ShowS
[TIFileData] -> ShowS
TIFileData -> String
(Int -> TIFileData -> ShowS)
-> (TIFileData -> String)
-> ([TIFileData] -> ShowS)
-> Show TIFileData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIFileData -> ShowS
showsPrec :: Int -> TIFileData -> ShowS
$cshow :: TIFileData -> String
show :: TIFileData -> String
$cshowList :: [TIFileData] -> ShowS
showList :: [TIFileData] -> ShowS
Show

-- | All TI Link files have a common header and
-- checksum, with a data section that differs
-- between backup and variable types.
-- See `TIFileData`.
data TIFile = TIFile {
    TIFile -> TIHeader
tiHeader :: TIHeader,
    TIFile -> TIFileData
tiData :: TIFileData,
    TIFile -> Word16
tiChecksum :: Word16
    } deriving Int -> TIFile -> ShowS
[TIFile] -> ShowS
TIFile -> String
(Int -> TIFile -> ShowS)
-> (TIFile -> String) -> ([TIFile] -> ShowS) -> Show TIFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TIFile -> ShowS
showsPrec :: Int -> TIFile -> ShowS
$cshow :: TIFile -> String
show :: TIFile -> String
$cshowList :: [TIFile] -> ShowS
showList :: [TIFile] -> ShowS
Show