{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module HOCD.Parse
  ( parseMem
  , parseRegisters
  , parseGetReg
  ) where

import HOCD.Types (RegisterInfo(..), RegisterName(..))
import Control.Applicative (optional)
import Data.Attoparsec.ByteString.Char8
import Data.Bits (FiniteBits(..))
import Data.ByteString (ByteString)
import Data.Map (Map)

import qualified Data.Map.Strict

parseMem
  :: ( FiniteBits a
     , Integral a
     )
  => Parser [a]
parseMem :: forall a. (FiniteBits a, Integral a) => Parser [a]
parseMem = (Parser ByteString ByteString
"0x" Parser ByteString ByteString
-> Parser ByteString a -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
forall a. (Integral a, Bits a) => Parser a
hexadecimal) Parser ByteString a
-> Parser ByteString Char -> Parser ByteString [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ByteString Char
space

parseRegisters :: Parser (Map RegisterName RegisterInfo)
parseRegisters :: Parser (Map RegisterName RegisterInfo)
parseRegisters =
      [(RegisterName, RegisterInfo)] -> Map RegisterName RegisterInfo
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.Strict.fromList
    ([(RegisterName, RegisterInfo)] -> Map RegisterName RegisterInfo)
-> ([[(RegisterName, RegisterInfo)]]
    -> [(RegisterName, RegisterInfo)])
-> [[(RegisterName, RegisterInfo)]]
-> Map RegisterName RegisterInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(RegisterName, RegisterInfo)]] -> [(RegisterName, RegisterInfo)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[(RegisterName, RegisterInfo)]] -> Map RegisterName RegisterInfo)
-> Parser ByteString [[(RegisterName, RegisterInfo)]]
-> Parser (Map RegisterName RegisterInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [(RegisterName, RegisterInfo)]
-> Parser ByteString [[(RegisterName, RegisterInfo)]]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString [(RegisterName, RegisterInfo)]
parseRegisterGroups

parseRegisterGroups :: Parser [(RegisterName, RegisterInfo)]
parseRegisterGroups :: Parser ByteString [(RegisterName, RegisterInfo)]
parseRegisterGroups = do
  ByteString
group <- Parser ByteString ByteString
parseRegisterGroup Parser ByteString ByteString
-> String -> Parser ByteString ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"Register group"
  Parser ()
endOfLine
  [(RegisterName, RegisterInfo)]
rgs <- ByteString -> Parser (RegisterName, RegisterInfo)
parseRegister ByteString
group Parser (RegisterName, RegisterInfo)
-> Parser () -> Parser ByteString [(RegisterName, RegisterInfo)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Parser ()
endOfLine
  Parser ()
endOfLine
  [(RegisterName, RegisterInfo)]
-> Parser ByteString [(RegisterName, RegisterInfo)]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(RegisterName, RegisterInfo)]
rgs

parseRegisterGroup :: Parser ByteString
parseRegisterGroup :: Parser ByteString ByteString
parseRegisterGroup =
     (Parser ByteString ByteString
"=====" Parser ByteString ByteString
-> String -> Parser ByteString ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"Prefix")
  Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
space
  Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char -> Bool
inClass String
"\n\r")

parseRegister
  :: ByteString
  -> Parser (RegisterName, RegisterInfo)
parseRegister :: ByteString -> Parser (RegisterName, RegisterInfo)
parseRegister ByteString
group = do
  Int
_regId <- Parser ByteString ByteString
"(" Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString Int
forall a. Integral a => Parser a
decimal :: Parser Int) Parser ByteString Int
-> Parser ByteString ByteString -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
")"
  Char
_ <- Parser ByteString Char
space
  RegisterName
regName <- ByteString -> RegisterName
RegisterName (ByteString -> RegisterName)
-> Parser ByteString ByteString -> Parser ByteString RegisterName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeTill Char -> Bool
isSpace
  Char
_ <- Parser ByteString Char
space
  Word8
registerInfoSize <- Parser ByteString ByteString
"(/" Parser ByteString ByteString
-> Parser ByteString Word8 -> Parser ByteString Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Word8
forall a. Integral a => Parser a
decimal Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
")"
  Maybe Word64
registerInfoValue <- Parser ByteString Word64 -> Parser ByteString (Maybe Word64)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
": 0x" Parser ByteString ByteString
-> Parser ByteString Word64 -> Parser ByteString Word64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Word64
forall a. (Integral a, Bits a) => Parser a
hexadecimal)
  Maybe ByteString
dirty <- Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ByteString
" (dirty)"
  let
    registerInfoDirty :: Bool
registerInfoDirty =
      case Maybe ByteString
dirty of
        Maybe ByteString
Nothing -> Bool
False
        Just ByteString
_ -> Bool
True
    registerInfoGroup :: ByteString
registerInfoGroup = ByteString
group
  (RegisterName, RegisterInfo) -> Parser (RegisterName, RegisterInfo)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RegisterName
regName, RegisterInfo{Bool
Maybe Word64
Word8
ByteString
registerInfoSize :: Word8
registerInfoValue :: Maybe Word64
registerInfoDirty :: Bool
registerInfoGroup :: ByteString
registerInfoSize :: Word8
registerInfoValue :: Maybe Word64
registerInfoDirty :: Bool
registerInfoGroup :: ByteString
..})

  Parser (RegisterName, RegisterInfo)
-> Parser () -> Parser (RegisterName, RegisterInfo)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ()
skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char -> Bool
inClass String
"\n\r")

parseGetReg
  :: ( FiniteBits a
     , Integral a
     )
  => RegisterName
  -> Parser a
parseGetReg :: forall a. (FiniteBits a, Integral a) => RegisterName -> Parser a
parseGetReg (RegisterName ByteString
rName) =
  ByteString -> Parser ByteString ByteString
string ByteString
rName
  Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
space
  Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"0x"
  Parser ByteString ByteString
-> Parser ByteString a -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString a
forall a. (Integral a, Bits a) => Parser a
hexadecimal