{-# language DataKinds         #-}
{-# language GADTs             #-}
{-# language KindSignatures    #-}
{-# language OverloadedStrings #-}
{-# language ViewPatterns      #-}
{- |
Module      :  System.Hardware.FXPak
Copyright   :  (c) Christina Wuest 2021
License     :  BSD-style

Maintainer  :  tina@wuest.me
Stability   :  experimental
Portability :  non-portable

Interface to working with the FXPak/FXPak Pro flash cart devices for the
SNES/Super Famicom
-}

module System.Hardware.FXPak ( FXPak
                             , Packet, Opcode(..), Context(..), Arguments(..)
                             , FI.AddressGet(..), FI.AddressSet(..)
                             , FI.Flag(..), Flags
                             , open, with, packet, send
                             ) where

import Prelude

import qualified System.Hardware.Serialport as Serial
import qualified Data.ByteString.Char8 as BS

import Control.Monad.IO.Class ( liftIO )
import Data.Bits ( (.&.), shiftR )
import Data.Char ( chr, ord )

import qualified System.Hardware.FXPak.Internal as FI

-- | An FXPak device (which is exposed as a serial device)
type FXPak = Serial.SerialPort

-- | A packet representing a single complete to send to the FXPak
type Packet = FI.Packet

-- | Represents an address to fetch memory from and a length to read
type AddressGet = FI.AddressGet

-- | Represents a value and the address to which it should be written
type AddressSet = FI.AddressSet

-- | The context in which a packet's command operates
data Context c where
    -- | In the File mode, files can be managed directly, and booted
    File   :: Context (FI.Context' 'FI.File)
    -- | In the SNES context, bytes can be written to and read from memory, and
    -- all system commands (e.g. reset, powercycle, reset to menu, system info,
    -- and stream data) are passed through
    SNES   :: Context (FI.Context' 'FI.SNES)
    MSU    :: Context (FI.Context' 'FI.MSU)
    Config :: Context (FI.Context' 'FI.Config)

-- | The Opcode representing the command to perform
data Opcode o where
    -- | Depending on context, either return the contents of a given file, or
    -- read memory
    Get        :: Opcode (FI.Opcode' 'FI.Get)
    -- | Depending on context, either allow the upload of a file, or write bytes
    -- to memory
    Put        :: Opcode (FI.Opcode' 'FI.Put)
    -- | Retrieve from 1-4 regions of memory
    VGet       :: Opcode (FI.Opcode' 'FI.VGet)
    -- | Write from 1-4 bytes to memory
    VPut       :: Opcode (FI.Opcode' 'FI.VPut)
    -- | List files in a given directory
    List       :: Opcode (FI.Opcode' 'FI.List)
    -- | Make a given directory on the FXPak's filesystem
    Mkdir      :: Opcode (FI.Opcode' 'FI.Mkdir)
    -- | Delete a given path on the FXPak's filesystem
    Delete     :: Opcode (FI.Opcode' 'FI.Delete)
    -- | Move a given path on the FXPak's filesystem to a new location
    Move       :: Opcode (FI.Opcode' 'FI.Move)
    -- | Reset the SNES/SFC
    Reset      :: Opcode (FI.Opcode' 'FI.Reset)
    -- | Boot a given file
    Boot       :: Opcode (FI.Opcode' 'FI.Boot)
    -- | Reset the SNES/SFC
    PowerCycle :: Opcode (FI.Opcode' 'FI.PowerCycle)
    -- | Return information about the running FXPak
    Info       :: Opcode (FI.Opcode' 'FI.Info)
    -- | Reset the SNES/SFC, returning to the FXPak's main menu
    MenuReset  :: Opcode (FI.Opcode' 'FI.MenuReset)
    Stream     :: Opcode (FI.Opcode' 'FI.Stream)
    Time       :: Opcode (FI.Opcode' 'FI.Time)
    -- | Indicates a response packet
    Response   :: Opcode (FI.Opcode' 'FI.Response)

-- | Arguments indicating the desired action taken by a given operation
data Arguments a where
    -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and
    -- PowerCycle opcodes
    None         :: Arguments (FI.Arguments' 'FI.None)
    -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot
    -- in the File context
    Path         :: FilePath -> Arguments (FI.Arguments' ('FI.Path (a :: FilePath)))
    -- | Path with an accompanying ByteString - valid only for Put in the File
    -- context
    PathContents :: FilePath -> BS.ByteString -> Arguments (FI.Arguments' ('FI.PathContents (a :: FilePath) (b :: BS.ByteString)))
    -- | Source and destination paths - valid only for Move in the File context
    PathRename   :: FilePath -> FilePath -> Arguments (FI.Arguments' ('FI.PathRename (a :: FilePath) a))
    -- | An address and length of data to be read for non-File context Get and
    -- VGet opcodes
    GetBytes     :: AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes (a :: AddressGet)))
    -- | Two address/length pairs to be read for non-File context VGet
    GetBytes2    :: AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes2 (a :: (AddressGet, AddressGet))))
    -- | Three address/length pairs to be read for non-File context VGet
    GetBytes3    :: AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes3 (a :: (AddressGet, AddressGet, AddressGet))))
    -- | Four address/length pairs to be read for non-File context VGet
    GetBytes4    :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments (FI.Arguments' ('FI.GetBytes4 (a :: (AddressGet, AddressGet, AddressGet, AddressGet))))
    -- | A target address and byte to be written for non-File context Put and
    -- VPut opcodes
    SetByte      :: AddressSet -> Arguments (FI.Arguments' ('FI.SetByte (a :: AddressSet)))
    -- | Two address/data pairs to be written for non-File context VPut
    SetByte2     :: AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte2 (a :: (AddressSet, AddressSet))))
    -- | Three address/data pairs to be written for non-File context VPut
    SetByte3     :: AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte3 (a :: (AddressSet, AddressSet, AddressSet))))
    -- | Four address/data pairs to be written for non-File context VPut
    SetByte4     :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments (FI.Arguments' ('FI.SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet))))

-- | List of Flags to be encoded for a given packet
type Flags = FI.Flags

-- | Given a Context (wrapping the internal type-safe Context' construct),
-- produce the internal construct for the purposes of packet construction
context :: Context (FI.Context' c) -> FI.Context' c
context :: Context (Context' c) -> Context' c
context Context (Context' c)
File   = Context' c
Context' 'File
FI.File'
context Context (Context' c)
SNES   = Context' c
Context' 'SNES
FI.SNES'
context Context (Context' c)
MSU    = Context' c
Context' 'MSU
FI.MSU'
context Context (Context' c)
Config = Context' c
Context' 'Config
FI.Config'

-- | Given an Opcode (wrapping the internal type-safe Opcode' construct),
-- produce the internal construct for the purposes of packet construction
opcode :: Opcode (FI.Opcode' o) -> FI.Opcode' o
opcode :: Opcode (Opcode' o) -> Opcode' o
opcode Opcode (Opcode' o)
Get        = Opcode' o
Opcode' 'Get
FI.Get'
opcode Opcode (Opcode' o)
Put        = Opcode' o
Opcode' 'Put
FI.Put'
opcode Opcode (Opcode' o)
VGet       = Opcode' o
Opcode' 'VGet
FI.VGet'
opcode Opcode (Opcode' o)
VPut       = Opcode' o
Opcode' 'VPut
FI.VPut'
opcode Opcode (Opcode' o)
List       = Opcode' o
Opcode' 'List
FI.List'
opcode Opcode (Opcode' o)
Mkdir      = Opcode' o
Opcode' 'Mkdir
FI.Mkdir'
opcode Opcode (Opcode' o)
Delete     = Opcode' o
Opcode' 'Delete
FI.Delete'
opcode Opcode (Opcode' o)
Move       = Opcode' o
Opcode' 'Move
FI.Move'
opcode Opcode (Opcode' o)
Reset      = Opcode' o
Opcode' 'Reset
FI.Reset'
opcode Opcode (Opcode' o)
Boot       = Opcode' o
Opcode' 'Boot
FI.Boot'
opcode Opcode (Opcode' o)
PowerCycle = Opcode' o
Opcode' 'PowerCycle
FI.PowerCycle'
opcode Opcode (Opcode' o)
Info       = Opcode' o
Opcode' 'Info
FI.Info'
opcode Opcode (Opcode' o)
MenuReset  = Opcode' o
Opcode' 'MenuReset
FI.MenuReset'
opcode Opcode (Opcode' o)
Stream     = Opcode' o
Opcode' 'Stream
FI.Stream'
opcode Opcode (Opcode' o)
Time       = Opcode' o
Opcode' 'Time
FI.Time'
opcode Opcode (Opcode' o)
Response   = Opcode' o
Opcode' 'Response
FI.Response'

-- | Given an Arguments datum (wrapping the internal type-safe Arguments'
-- construct), -- produce the internal construct for the purposes of packet
-- construction
arguments :: Arguments (FI.Arguments' a) -> FI.Arguments' a
arguments :: Arguments (Arguments' a) -> Arguments' a
arguments Arguments (Arguments' a)
None                = Arguments' a
Arguments' 'None
FI.None'
arguments (Path FilePath
a)            = FilePath -> Arguments' ('Path a)
forall (a :: FilePath). FilePath -> Arguments' ('Path a)
FI.Path' FilePath
a
arguments (PathContents FilePath
a ByteString
b)  = FilePath -> ByteString -> Arguments' ('PathContents a b)
forall (a :: FilePath) (b :: ByteString).
FilePath -> ByteString -> Arguments' ('PathContents a b)
FI.PathContents' FilePath
a ByteString
b
arguments (PathRename FilePath
a FilePath
b)    = FilePath -> FilePath -> Arguments' ('PathRename a a)
forall (a :: FilePath).
FilePath -> FilePath -> Arguments' ('PathRename a a)
FI.PathRename' FilePath
a FilePath
b
arguments (GetBytes AddressGet
a)        = AddressGet -> Arguments' ('GetBytes a)
forall (a :: AddressGet). AddressGet -> Arguments' ('GetBytes a)
FI.GetBytes' AddressGet
a
arguments (GetBytes2 AddressGet
a AddressGet
b)     = AddressGet -> AddressGet -> Arguments' ('GetBytes2 a)
forall (a :: (AddressGet, AddressGet)).
AddressGet -> AddressGet -> Arguments' ('GetBytes2 a)
FI.GetBytes2' AddressGet
a AddressGet
b
arguments (GetBytes3 AddressGet
a AddressGet
b AddressGet
c)   = AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes3 a)
forall (a :: (AddressGet, AddressGet, AddressGet)).
AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes3 a)
FI.GetBytes3' AddressGet
a AddressGet
b AddressGet
c
arguments (GetBytes4 AddressGet
a AddressGet
b AddressGet
c AddressGet
d) = AddressGet
-> AddressGet
-> AddressGet
-> AddressGet
-> Arguments' ('GetBytes4 a)
forall (a :: (AddressGet, AddressGet, AddressGet, AddressGet)).
AddressGet
-> AddressGet
-> AddressGet
-> AddressGet
-> Arguments' ('GetBytes4 a)
FI.GetBytes4' AddressGet
a AddressGet
b AddressGet
c AddressGet
d
arguments (SetByte AddressSet
a)         = AddressSet -> Arguments' ('SetByte a)
forall (a :: AddressSet). AddressSet -> Arguments' ('SetByte a)
FI.SetByte' AddressSet
a
arguments (SetByte2 AddressSet
a AddressSet
b)      = AddressSet -> AddressSet -> Arguments' ('SetByte2 a)
forall (a :: (AddressSet, AddressSet)).
AddressSet -> AddressSet -> Arguments' ('SetByte2 a)
FI.SetByte2' AddressSet
a AddressSet
b
arguments (SetByte3 AddressSet
a AddressSet
b AddressSet
c)    = AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte3 a)
forall (a :: (AddressSet, AddressSet, AddressSet)).
AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte3 a)
FI.SetByte3' AddressSet
a AddressSet
b AddressSet
c
arguments (SetByte4 AddressSet
a AddressSet
b AddressSet
c AddressSet
d)  = AddressSet
-> AddressSet
-> AddressSet
-> AddressSet
-> Arguments' ('SetByte4 a)
forall (a :: (AddressSet, AddressSet, AddressSet, AddressSet)).
AddressSet
-> AddressSet
-> AddressSet
-> AddressSet
-> Arguments' ('SetByte4 a)
FI.SetByte4' AddressSet
a AddressSet
b AddressSet
c AddressSet
d

-- | Open a given serial device as an FXPak
open :: FilePath -> IO FXPak
open :: FilePath -> IO FXPak
open = (FilePath -> SerialPortSettings -> IO FXPak)
-> SerialPortSettings -> FilePath -> IO FXPak
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> SerialPortSettings -> IO FXPak
Serial.openSerial SerialPortSettings
Serial.defaultSerialSettings

with :: FilePath -> (FXPak -> IO a) -> IO a
with :: FilePath -> (FXPak -> IO a) -> IO a
with = (FilePath -> SerialPortSettings -> (FXPak -> IO a) -> IO a)
-> SerialPortSettings -> FilePath -> (FXPak -> IO a) -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> SerialPortSettings -> (FXPak -> IO a) -> IO a
forall a. FilePath -> SerialPortSettings -> (FXPak -> IO a) -> IO a
Serial.withSerial SerialPortSettings
Serial.defaultSerialSettings

-- | Encode a packet to send to an FXPak, preventing encoding of invalid packets
packet :: (FI.ValidPacket c o a ~ 'True) => Context (FI.Context' c) -> Opcode (FI.Opcode' o) -> Flags -> Arguments (FI.Arguments' a) -> Packet
packet :: Context (Context' c)
-> Opcode (Opcode' o)
-> Flags
-> Arguments (Arguments' a)
-> Packet
packet (Context (Context' c) -> Context' c
forall (c :: Context). Context (Context' c) -> Context' c
context -> Context' c
c) (Opcode (Opcode' o) -> Opcode' o
forall (o :: Opcode). Opcode (Opcode' o) -> Opcode' o
opcode -> Opcode' o
o) Flags
flags (Arguments (Arguments' a) -> Arguments' a
forall (a :: Arguments). Arguments (Arguments' a) -> Arguments' a
arguments -> Arguments' a
a) = Context' c -> Opcode' o -> Flags -> Arguments' a -> Packet
forall (c :: Context) (o :: Opcode) (a :: Arguments).
(ValidPacket c o a ~ 'True) =>
Context' c -> Opcode' o -> Flags -> Arguments' a -> Packet
FI.packet Context' c
c Opcode' o
o Flags
flags Arguments' a
a

-- | Sends a given packet to an FXPak device, returning a ByteString if a
-- response is expected
send :: FXPak -> Packet -> IO (Maybe BS.ByteString)
send :: FXPak -> Packet -> IO (Maybe ByteString)
send FXPak
dev Packet
dat = do
    Int
_ <- FXPak -> ByteString -> IO Int
Serial.send FXPak
dev (ByteString -> IO Int) -> ByteString -> IO Int
forall a b. (a -> b) -> a -> b
$ Packet -> ByteString
pack Packet
dat
    let (FI.Packet Opcode
_ Context
_ Flags
flags Arguments
_) = Packet
dat
    if Flag -> Flags -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Flag
FI.NoResponse Flags
flags
        then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
        else do
            ByteString
resp <- IO ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> FXPak -> [ByteString] -> IO ByteString
readSerial Int
512 FXPak
dev []
            let resp' :: FilePath
resp' = ByteString -> FilePath
BS.unpack ByteString
resp in
                if (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
5 FilePath
resp') FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char
'U', Char
'S', Char
'B', Char
'A', Char
'\x0F']
                    then Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
                    else FXPak -> [Int] -> IO (Maybe ByteString)
fetch FXPak
dev ([Int] -> IO (Maybe ByteString)) -> [Int] -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> FilePath -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Int
ord (FilePath -> [Int]) -> FilePath -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
255 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
resp'

-- | Read a number of bytes from the FXPak designated by a string fro
-- a string read from the serial device
fetch :: FXPak -> [Int] -> IO (Maybe BS.ByteString)
fetch :: FXPak -> [Int] -> IO (Maybe ByteString)
fetch FXPak
_ []         = Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
fetch FXPak
_ (Int
0:[Int]
_)      = Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
fetch FXPak
dev (Int
size:[Int]
_) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> FXPak -> [ByteString] -> IO ByteString
readSerial Int
size FXPak
dev []

-- | Convert a Packet to a ByteString ready to be sent to the FXPak device,
-- enforcing the appropriate packet size
pack :: Packet -> BS.ByteString
pack :: Packet -> ByteString
pack (FI.Packet Opcode
o Context
c Flags
f Arguments
a) =
    let op :: Char
op = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Opcode -> Int
forall a. Enum a => a -> Int
fromEnum Opcode
o
        ctx :: Char
ctx = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Context -> Int
forall a. Enum a => a -> Int
fromEnum Context
c
        flags :: Char
flags = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Flags -> Int
FI.fromFlags Flags
f
    -- "USBA" string is taken from the original usb2snesw application
    in Bool -> Opcode -> Arguments -> FilePath -> ByteString
pack' (Flag -> Flags -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Flag
FI.Data64Bytes Flags
f) Opcode
o Arguments
a [Char
'U', Char
'S', Char
'B', Char
'A', Char
op, Char
ctx, Char
flags]

-- | Select the appropriate size pack function given the opcode and flags given
pack' :: Bool -> FI.Opcode -> FI.Arguments -> [Char] -> BS.ByteString
pack' :: Bool -> Opcode -> Arguments -> FilePath -> ByteString
pack' Bool
True  Opcode
_       = Arguments -> FilePath -> ByteString
pack64
pack' Bool
False Opcode
FI.VPut = Arguments -> FilePath -> ByteString
pack64
pack' Bool
False Opcode
FI.VGet = Arguments -> FilePath -> ByteString
pack64
pack' Bool
False Opcode
_       = Arguments -> FilePath -> ByteString
pack512

-- | Given a set of GetBytes/SetByte arguments and packet header, generate a 64
-- byte packet
-- Note: 64 byte packets can only be generated for the VGet/VPut opcodes, and
-- therefore any non-GetBytes/SetByte operations are considered undefined in
-- this context
pack64 :: FI.Arguments -> String -> BS.ByteString
pack64 :: Arguments -> FilePath -> ByteString
pack64 (FI.GetBytes AddressGet
addrGet) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
24)
pack64 (FI.GetBytes2 (AddressGet
addrGet, AddressGet
addrGet2)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
16)
pack64 (FI.GetBytes3 (AddressGet
addrGet, AddressGet
addrGet2, AddressGet
addrGet3)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
8)
pack64 (FI.GetBytes4 (AddressGet
addrGet, AddressGet
addrGet2, AddressGet
addrGet3, AddressGet
addrGet4)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet4)
pack64 (FI.SetByte AddressSet
addrSet) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
24)
pack64 (FI.SetByte2 (AddressSet
addrSet, AddressSet
addrSet2)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
16)
pack64 (FI.SetByte3 (AddressSet
addrSet, AddressSet
addrSet2, AddressSet
addrSet3)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
8)
pack64 (FI.SetByte4 (AddressSet
addrSet, AddressSet
addrSet2, AddressSet
addrSet3, AddressSet
addrSet4)) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
25) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet2) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet4)
pack64 Arguments
_ FilePath
_ = ByteString
forall a. HasCallStack => a
undefined

-- | Given a set of arguments and packet header, generate a 512 byte packet
-- Note: VGet/VPut-specific arguments (GetBytes2+/SetByte2+) are considered
-- undefined in this context, as VGet/VPut must use 64-byte packet
pack512 :: FI.Arguments -> String -> BS.ByteString
pack512 :: Arguments -> FilePath -> ByteString
pack512 Arguments
FI.None FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
505)
pack512 (FI.Path FilePath
p) FilePath
tmp =
    let p' :: FilePath
p' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
255 FilePath
p
    in FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
249) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
p')))
pack512 (FI.PathRename FilePath
s FilePath
d) FilePath
tmp =
    let s' :: FilePath
s' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
255 FilePath
s
        d' :: FilePath
d' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
248 FilePath
d
    in FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls (Int
249 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
d'))) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s')))
pack512 (FI.GetBytes AddressGet
addrGet) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
245) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressGet -> FilePath
fromAddressGet AddressGet
addrGet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
252)
pack512 (FI.SetByte AddressSet
addrSet) FilePath
tmp = FilePath -> ByteString
BS.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
tmp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
245) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (AddressSet -> FilePath
fromAddressSet AddressSet
addrSet) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Int -> FilePath
nulls Int
252)
pack512 Arguments
_ FilePath
_ = ByteString
forall a. HasCallStack => a
undefined

-- | Generate an 8 byte string from an AddressGet
fromAddressGet :: AddressGet -> String
fromAddressGet :: AddressGet -> FilePath
fromAddressGet AddressGet
ag =
    let validSize :: Char
validSize = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&.) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ AddressGet -> Int
FI.dataLength AddressGet
ag
        addr :: Int
addr = AddressGet -> Int
FI.start AddressGet
ag
        addrhi :: Char
addrhi = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
addr Int
16)
        addrmid :: Char
addrmid = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
addr Int
8)
        addrlow :: Char
addrlow = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
addr
    in (Int -> FilePath
nulls Int
3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
validSize, Int -> Char
chr Int
0x00, Char
addrhi, Char
addrmid, Char
addrlow]

-- | Generate an 8 byte string from an AddressSet
fromAddressSet :: AddressSet -> String
fromAddressSet :: AddressSet -> FilePath
fromAddressSet AddressSet
as =
    let addr :: Int
addr = AddressSet -> Int
FI.target AddressSet
as
        byte :: Char
byte = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&.) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ AddressSet -> Int
FI.value AddressSet
as
        addrhi :: Char
addrhi = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
16 Int
addr)
        addrmid :: Char
addrmid = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
8 Int
addr)
        addrlow :: Char
addrlow = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xFF Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
addr
    in (Int -> FilePath
nulls Int
3) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
byte, Int -> Char
chr Int
0x00, Char
addrhi, Char
addrmid, Char
addrlow]

-- | Convenience function to generate arbitrary length string of NUL bytes
nulls :: Int -> String
nulls :: Int -> FilePath
nulls Int
x = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
x (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Int -> Char) -> [Int] -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr ([Int] -> FilePath) -> [Int] -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. a -> [a]
repeat Int
0x00

-- | Read a given number of bytes from the FXPak
readSerial :: Int -> FXPak -> [BS.ByteString] -> IO BS.ByteString
readSerial :: Int -> FXPak -> [ByteString] -> IO ByteString
readSerial Int
size FXPak
dev [ByteString]
bufs =
    let currSize :: Int
currSize = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Int
BS.length [ByteString]
bufs
    in
        if Int
currSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size
           then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ByteString -> ByteString -> ByteString
BS.append ByteString
"" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
bufs
           else do
               ByteString
dat <- FXPak -> Int -> IO ByteString
Serial.recv FXPak
dev (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currSize
               Int -> FXPak -> [ByteString] -> IO ByteString
readSerial Int
size FXPak
dev ([ByteString] -> IO ByteString) -> [ByteString] -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
datByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bufs