fxpak (empty) → 0.0.1
raw patch · 6 files changed
+583/−0 lines, 6 filesdep +basedep +bytestringdep +serialportsetup-changed
Dependencies added: base, bytestring, serialport
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- fxpak.cabal +27/−0
- src/FXPak.hs +287/−0
- src/FXPak/Internal.hs +230/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Revision history for fxpak++## 0.0.1 -- 2021-03-14++* Pre-release work uploaded to github+ - Able to encode most packet types+ - Enforces packet constraints at the type level
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021 Tina Wuest++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Tina Wuest nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fxpak.cabal view
@@ -0,0 +1,27 @@+name: fxpak+version: 0.0.1+synopsis: Interface to the FXPak/FXPak Pro USB interface+description: Wraps Serial interaction with FXPak/FXPak Pro devices+homepage: https://github.com/wuest/fxpak+bug-reports: https://github.com/wuest/fxpak/issues+license: BSD3+license-file: LICENSE+author: Tina Wuest+maintainer: tina@wuest.me+copyright: 2021 Tina Wuest+category: Hardware+build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++library+ ghc-options: -Wall -fwarn-implicit-prelude -fwarn-monomorphism-restriction -static+ default-language: Haskell2010+ hs-source-dirs: src++ exposed-modules: FXPak+ other-modules: FXPak.Internal++ build-depends: base >= 4.9 && < 4.15+ , serialport >= 0.5 && < 0.6+ , bytestring >= 0.11 && < 0.12
+ src/FXPak.hs view
@@ -0,0 +1,287 @@+{-# language DataKinds #-}+{-# language GADTs #-}+{-# language KindSignatures #-}+{-# language OverloadedStrings #-}+{-# language ViewPatterns #-}+{- |+Module : 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 FXPak ( FXPak+ , Packet, Opcode(..), Context(..), Arguments(..)+ , FI.AddressGet(..), FI.AddressSet(..)+ , FI.Flag(..), Flags+ , open, 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 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 File = FI.File'+context SNES = FI.SNES'+context MSU = FI.MSU'+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 Get = FI.Get'+opcode Put = FI.Put'+opcode VGet = FI.VGet'+opcode VPut = FI.VPut'+opcode List = FI.List'+opcode Mkdir = FI.Mkdir'+opcode Delete = FI.Delete'+opcode Move = FI.Move'+opcode Reset = FI.Reset'+opcode Boot = FI.Boot'+opcode PowerCycle = FI.PowerCycle'+opcode Info = FI.Info'+opcode MenuReset = FI.MenuReset'+opcode Stream = FI.Stream'+opcode Time = FI.Time'+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 None = FI.None'+arguments (Path a) = FI.Path' a+arguments (PathContents a b) = FI.PathContents' a b+arguments (PathRename a b) = FI.PathRename' a b+arguments (GetBytes a) = FI.GetBytes' a+arguments (GetBytes2 a b) = FI.GetBytes2' a b+arguments (GetBytes3 a b c) = FI.GetBytes3' a b c+arguments (GetBytes4 a b c d) = FI.GetBytes4' a b c d+arguments (SetByte a) = FI.SetByte' a+arguments (SetByte2 a b) = FI.SetByte2' a b+arguments (SetByte3 a b c) = FI.SetByte3' a b c+arguments (SetByte4 a b c d) = FI.SetByte4' a b c d++-- | Open a given serial device as an FXPak+open :: FilePath -> IO FXPak+open = flip Serial.openSerial 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 -> c) (opcode -> o) flags (arguments -> a) = FI.packet c o flags 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 dev dat = do+ _ <- Serial.send dev $ pack dat+ let (FI.Packet _ _ flags _) = dat+ if elem FI.NoResponse flags+ then return Nothing+ else do+ resp <- liftIO $ readSerial 512 dev []+ let resp' = BS.unpack resp in+ if (take 5 resp') /= ['U', 'S', 'B', 'A', '\x0F']+ then return Nothing+ else fetch dev $ fmap ord $ drop 255 $ 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 _ [] = return Nothing+fetch _ (0:_) = return Nothing+fetch dev (size:_) = Just <$> readSerial size 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 (FI.Packet o c f a) =+ let op = chr $ fromEnum o+ ctx = chr $ fromEnum c+ flags = chr $ FI.fromFlags f+ -- "USBA" string is taken from the original usb2snesw application+ in pack' (elem FI.Data64Bytes f) o a ['U', 'S', 'B', 'A', op, ctx, flags]++-- | Select the appropriate size pack function given the opcode and flags given+pack' :: Bool -> FI.Opcode -> FI.Arguments -> [Char] -> BS.ByteString+pack' True _ = pack64+pack' False FI.VPut = pack64+pack' False FI.VGet = pack64+pack' False _ = 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 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (nulls 24)+pack64 (FI.GetBytes2 (addrGet, addrGet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (nulls 16)+pack64 (FI.GetBytes3 (addrGet, addrGet2, addrGet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (nulls 8)+pack64 (FI.GetBytes4 (addrGet, addrGet2, addrGet3, addrGet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressGet addrGet) ++ (fromAddressGet addrGet2) ++ (fromAddressGet addrGet3) ++ (fromAddressGet addrGet4)+pack64 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (nulls 24)+pack64 (FI.SetByte2 (addrSet, addrSet2)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (nulls 16)+pack64 (FI.SetByte3 (addrSet, addrSet2, addrSet3)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (nulls 8)+pack64 (FI.SetByte4 (addrSet, addrSet2, addrSet3, addrSet4)) tmp = BS.pack $ tmp ++ (nulls 25) ++ (fromAddressSet addrSet) ++ (fromAddressSet addrSet2) ++ (fromAddressSet addrSet3) ++ (fromAddressSet addrSet4)+pack64 _ _ = 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 FI.None tmp = BS.pack $ tmp ++ (nulls 505)+pack512 (FI.Path p) tmp =+ let p' = take 255 p+ in BS.pack $ tmp ++ (nulls 249) ++ p' ++ (nulls (256 - (length p')))+pack512 (FI.PathRename s d) tmp =+ let s' = take 255 s+ d' = take 248 d+ in BS.pack $ tmp ++ d' ++ (nulls (249 - (length d'))) ++ s' ++ (nulls (256 - (length s')))+pack512 (FI.GetBytes addrGet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressGet addrGet) ++ (nulls 252)+pack512 (FI.SetByte addrSet) tmp = BS.pack $ tmp ++ (nulls 245) ++ (fromAddressSet addrSet) ++ (nulls 252)+pack512 _ _ = undefined++-- | Generate an 8 byte string from an AddressGet+fromAddressGet :: AddressGet -> String+fromAddressGet ag =+ let validSize = chr $ (0xFF .&.) $ FI.dataLength ag+ addr = FI.start ag+ addrhi = chr $ 0xFF .&. (shiftR addr 16)+ addrmid = chr $ 0xFF .&. (shiftR addr 8)+ addrlow = chr $ 0xFF .&. addr+ in (nulls 3) ++ [validSize, chr 0x00, addrhi, addrmid, addrlow]++-- | Generate an 8 byte string from an AddressSet+fromAddressSet :: AddressSet -> String+fromAddressSet as =+ let addr = FI.target as+ byte = chr $ (0xFF .&.) $ FI.value as+ addrhi = chr $ 0xFF .&. (shiftR 16 addr)+ addrmid = chr $ 0xFF .&. (shiftR 8 addr)+ addrlow = chr $ 0xFF .&. addr+ in (nulls 3) ++ [byte, chr 0x00, addrhi, addrmid, addrlow]++-- | Convenience function to generate arbitrary length string of NUL bytes+nulls :: Int -> String+nulls x = take x $ fmap chr $ repeat 0x00++-- | Read a given number of bytes from the FXPak+readSerial :: Int -> FXPak -> [BS.ByteString] -> IO BS.ByteString+readSerial size dev bufs =+ let currSize = sum $ fmap BS.length bufs+ in+ if currSize >= size+ then return $ foldl BS.append "" $ reverse bufs+ else do+ dat <- Serial.recv dev $ size - currSize+ readSerial size dev $ dat:bufs
+ src/FXPak/Internal.hs view
@@ -0,0 +1,230 @@+{-# language DataKinds #-}+{-# language GADTs #-}+{-# language TypeFamilies #-}+{-# language ViewPatterns #-}+{- |+Module : FXPak.Internal+Copyright : (c) Christina Wuest 2021+License : BSD-style++Maintainer : tina@wuest.me+Stability : experimental+Portability : non-portable++Internals for FXPak - ensures only valid packets can be encoded.+-}++module FXPak.Internal where++import Prelude++import qualified Data.ByteString.Char8 as BS++import Data.Bits ( (.|.), shiftL )++-- | Flags to be encoded as a 1-byte bit map+-- Note: No checking of flag validity is done in the original usb2snesw software+-- and as such research into which combinations produce expected results is+-- still underway+data Flag = SkipReset | OnlyReset | ClearX | SetX | StreamBurst | NoResponse | Data64Bytes deriving ( Eq, Show, Enum, Bounded )++-- | List of Flag data+-- Note: Since this will be reduced to a single bit map, flag duplication is not+-- considered invalid+type Flags = [Flag]++-- | Given a list of Flags, produce the bit map expected by the FXPak+fromFlags :: Flags -> Int+fromFlags = (foldl (.|.) 0) . (fmap $ (shiftL 1) . fromEnum)+++-- | The context in which a packet's command operates+data Context = File | SNES | MSU | Config deriving ( Eq, Show, Enum, Bounded )+data Context' (c :: Context) where+ -- | File contexts involve manipulation of the FXPak's filesystem, including+ -- booting files directly+ File' :: Context' 'File+ -- | SNES contexts involve the system's memory, allowing reading and writing+ -- of RAM+ SNES' :: Context' 'SNES+ MSU' :: Context' 'MSU+ Config' :: Context' 'Config++-- | View Pattern to extract a Context from its wrapping Context'+context :: Context' c -> Context+context File' = File+context SNES' = SNES+context MSU' = MSU+context Config' = Config++-- | Represents the operation to be performed by the FXPak+data Opcode = Get | Put | VGet | VPut+ | List | Mkdir | Delete | Move+ | Reset | Boot | PowerCycle | Info | MenuReset | Stream | Time+ | Response+ deriving ( Eq, Show, Enum, Bounded )+data Opcode' (o :: Opcode) where+ -- | Get the contents of a file or target memory+ Get' :: Opcode' 'Get+ -- | Write a file to the filesystem or a byte to memory+ Put' :: Opcode' 'Put+ -- | Read and return between 1 and 4 regions of memory+ VGet' :: Opcode' 'VGet+ -- | Write between 1 and 4 bytes to system memory+ VPut' :: Opcode' 'VPut+ -- | List files at a given path+ List' :: Opcode' 'List+ -- | Make a new directory at the given path+ Mkdir' :: Opcode' 'Mkdir+ -- | Delete a node in the FXPak's filesystem+ Delete' :: Opcode' 'Delete+ -- | Move a node in the FXPak's filesystem from one location to another+ Move' :: Opcode' 'Move+ -- | Reset the SNES/SFC+ Reset' :: Opcode' 'Reset+ -- | Boot a file at the target location+ Boot' :: Opcode' 'Boot+ -- | Reset the SNES/SFC+ PowerCycle' :: Opcode' 'PowerCycle+ -- | Return information about the running FXPak+ Info' :: Opcode' 'Info+ -- | Reset the SNES/SFC, returning to the FXPak's main menu+ MenuReset' :: Opcode' 'MenuReset+ Stream' :: Opcode' 'Stream+ Time' :: Opcode' 'Time+ -- | Indicates a response packet+ -- A user should never set this for an outgoing packet.+ Response' :: Opcode' 'Response++-- | View Pattern to extract a Opcode from its wrapping Opcode'+opcode :: Opcode' o -> Opcode+opcode Get' = Get+opcode Put' = Put+opcode VGet' = VGet+opcode VPut' = VPut+opcode List' = List+opcode Mkdir' = Mkdir+opcode Delete' = Delete+opcode Move' = Move+opcode Reset' = Reset+opcode Boot' = Boot+opcode PowerCycle' = PowerCycle+opcode Info' = Info+opcode MenuReset' = MenuReset+opcode Stream' = Stream+opcode Time' = Time+opcode Response' = Response++-- | Represents an address to fetch memory from and a length to read+data AddressGet = AddressGet { start :: Int+ , dataLength :: Int+ } deriving ( Show )++-- | Represents a value and the address to which it should be written+data AddressSet = AddressSet { target :: Int+ , value :: Int+ } deriving ( Show )++-- | Arguments indicating the desired action taken by a given operation+data Arguments = None+ | Path FilePath+ | PathContents FilePath BS.ByteString+ | PathRename FilePath FilePath+ | GetBytes AddressGet+ | GetBytes2 (AddressGet, AddressGet)+ | GetBytes3 (AddressGet, AddressGet, AddressGet)+ | GetBytes4 (AddressGet, AddressGet, AddressGet, AddressGet)+ | SetByte AddressSet+ | SetByte2 (AddressSet, AddressSet)+ | SetByte3 (AddressSet, AddressSet, AddressSet)+ | SetByte4 (AddressSet, AddressSet, AddressSet, AddressSet)+ deriving ( Show )+data Arguments' (a :: Arguments) where+ -- | No arguments - valid only with the Reset, MenuReset, Info, Stream, and+ -- PowerCycle opcodes+ None' :: Arguments' 'None+ -- | Path to a given object - valid for Get, List, Mkdir, Delete, and Boot+ -- in the File context+ Path' :: FilePath -> Arguments' ('Path (a :: FilePath))+ -- | Path with an accompanying ByteString - valid only for Put in the File+ -- context+ PathContents' :: FilePath -> BS.ByteString -> Arguments' ('PathContents (a :: FilePath) (b :: BS.ByteString))+ -- | Source and destination paths - valid only for Move in the File context+ PathRename' :: FilePath -> FilePath -> Arguments' ('PathRename (a :: FilePath) a)+ -- | An address and length of data to be read for non-File context Get and+ -- VGet opcodes+ GetBytes' :: AddressGet -> Arguments' ('GetBytes (a :: AddressGet))+ -- | Two address/length pairs to be read for non-File context VGet+ GetBytes2' :: AddressGet -> AddressGet -> Arguments' ('GetBytes2 (a :: (AddressGet, AddressGet)))+ -- | Three address/length pairs to be read for non-File context VGet+ GetBytes3' :: AddressGet -> AddressGet -> AddressGet -> Arguments' ('GetBytes3 (a :: (AddressGet, AddressGet, AddressGet)))+ -- | Four address/length pairs to be read for non-File context VGet+ GetBytes4' :: AddressGet -> AddressGet -> AddressGet -> AddressGet -> Arguments' ('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' ('SetByte (a :: AddressSet))+ -- | Two address/data pairs to be written for non-File context VPut+ SetByte2' :: AddressSet -> AddressSet -> Arguments' ('SetByte2 (a :: (AddressSet, AddressSet)))+ -- | Three address/data pairs to be written for non-File context VPut+ SetByte3' :: AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte3 (a :: (AddressSet, AddressSet, AddressSet)))+ -- | Four address/data pairs to be written for non-File context VPut+ SetByte4' :: AddressSet -> AddressSet -> AddressSet -> AddressSet -> Arguments' ('SetByte4 (a :: (AddressSet, AddressSet, AddressSet, AddressSet)))++-- | View Pattern to extract an Arguments datum from its wrapping Arguments'+arguments :: Arguments' a -> Arguments+arguments None' = None+arguments (Path' a) = Path a+arguments (PathContents' a b) = PathContents a b+arguments (PathRename' a b) = PathRename a b+arguments (GetBytes' a) = GetBytes a+arguments (GetBytes2' a b) = GetBytes2 (a, b)+arguments (GetBytes3' a b c) = GetBytes3 (a, b, c)+arguments (GetBytes4' a b c d) = GetBytes4 (a, b, c, d)+arguments (SetByte' a) = SetByte a+arguments (SetByte2' a b) = SetByte2 (a, b)+arguments (SetByte3' a b c) = SetByte3 (a, b, c)+arguments (SetByte4' a b c d) = SetByte4 (a, b, c, d)++-- | ValidPacket allows a constraint to be added to functions which would create+-- Packet data, guaranteeing that they are only able to generate packets+-- conforming to the expected specifications of the FXPak+type family ValidPacket (c :: Context) (o :: Opcode) (a :: Arguments) :: Bool where+ ValidPacket 'File 'Get ('Path _) = 'True+ ValidPacket 'File 'Put ('PathContents _ _) = 'True+ ValidPacket 'File 'List ('Path _) = 'True+ ValidPacket 'File 'Mkdir ('Path _) = 'True+ ValidPacket 'File 'Delete ('Path _) = 'True+ ValidPacket 'File 'Move ('PathRename _ _) = 'True+ ValidPacket 'File 'Boot ('Path _) = 'True++ ValidPacket 'File 'Get _ = 'False+ ValidPacket 'File 'Put _ = 'False+ ValidPacket 'File 'VGet _ = 'False+ ValidPacket 'File 'VPut _ = 'False++ ValidPacket _ 'Get ('GetBytes _) = 'True+ ValidPacket _ 'Put ('SetByte _) = 'True+ ValidPacket _ 'VGet ('GetBytes _) = 'True+ ValidPacket _ 'VGet ('GetBytes2 _) = 'True+ ValidPacket _ 'VGet ('GetBytes3 _) = 'True+ ValidPacket _ 'VGet ('GetBytes4 _) = 'True+ ValidPacket _ 'VPut ('SetByte _) = 'True+ ValidPacket _ 'VPut ('SetByte2 _) = 'True+ ValidPacket _ 'VPut ('SetByte3 _) = 'True+ ValidPacket _ 'VPut ('SetByte4 _) = 'True++ ValidPacket _ 'Reset 'None = 'True+ ValidPacket _ 'MenuReset 'None = 'True+ ValidPacket _ 'Info 'None = 'True+ ValidPacket _ 'Stream 'None = 'True+ ValidPacket _ 'PowerCycle 'None = 'True++ ValidPacket _ _ _ = 'False++-- | Represents a Packet to be sent to the FXPak+data Packet = Packet Opcode Context Flags Arguments deriving ( Show )++-- | Smart Constructor for a Packet, guaranteeing validity via the ValidPacket+-- constraint+packet :: (ValidPacket c o a ~ 'True) => (Context' c) -> (Opcode' o) -> Flags -> (Arguments' a) -> Packet+packet (context -> c) (opcode -> o) flags (arguments -> a) = Packet o c flags a