{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module HOCD.Types
  ( MemAddress(..)
  , memAddr
  , OCDConfig(..)
  ) where

import Data.Default.Class (Default(def))
import Data.Word (Word32)

newtype MemAddress = MemAddress
  { MemAddress -> Word32
unMemAddress :: Word32 }
  deriving (MemAddress -> MemAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemAddress -> MemAddress -> Bool
$c/= :: MemAddress -> MemAddress -> Bool
== :: MemAddress -> MemAddress -> Bool
$c== :: MemAddress -> MemAddress -> Bool
Eq, Eq MemAddress
MemAddress -> MemAddress -> Bool
MemAddress -> MemAddress -> Ordering
MemAddress -> MemAddress -> MemAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MemAddress -> MemAddress -> MemAddress
$cmin :: MemAddress -> MemAddress -> MemAddress
max :: MemAddress -> MemAddress -> MemAddress
$cmax :: MemAddress -> MemAddress -> MemAddress
>= :: MemAddress -> MemAddress -> Bool
$c>= :: MemAddress -> MemAddress -> Bool
> :: MemAddress -> MemAddress -> Bool
$c> :: MemAddress -> MemAddress -> Bool
<= :: MemAddress -> MemAddress -> Bool
$c<= :: MemAddress -> MemAddress -> Bool
< :: MemAddress -> MemAddress -> Bool
$c< :: MemAddress -> MemAddress -> Bool
compare :: MemAddress -> MemAddress -> Ordering
$ccompare :: MemAddress -> MemAddress -> Ordering
Ord, Int -> MemAddress -> ShowS
[MemAddress] -> ShowS
MemAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemAddress] -> ShowS
$cshowList :: [MemAddress] -> ShowS
show :: MemAddress -> String
$cshow :: MemAddress -> String
showsPrec :: Int -> MemAddress -> ShowS
$cshowsPrec :: Int -> MemAddress -> ShowS
Show, Integer -> MemAddress
MemAddress -> MemAddress
MemAddress -> MemAddress -> MemAddress
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MemAddress
$cfromInteger :: Integer -> MemAddress
signum :: MemAddress -> MemAddress
$csignum :: MemAddress -> MemAddress
abs :: MemAddress -> MemAddress
$cabs :: MemAddress -> MemAddress
negate :: MemAddress -> MemAddress
$cnegate :: MemAddress -> MemAddress
* :: MemAddress -> MemAddress -> MemAddress
$c* :: MemAddress -> MemAddress -> MemAddress
- :: MemAddress -> MemAddress -> MemAddress
$c- :: MemAddress -> MemAddress -> MemAddress
+ :: MemAddress -> MemAddress -> MemAddress
$c+ :: MemAddress -> MemAddress -> MemAddress
Num)

-- | Shorthand constructor
memAddr :: Word32 -> MemAddress
memAddr :: Word32 -> MemAddress
memAddr = Word32 -> MemAddress
MemAddress

data OCDConfig = OCDConfig
  { OCDConfig -> String
ocdHost :: String
  , OCDConfig -> Int
ocdPort :: Int
  } deriving (OCDConfig -> OCDConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OCDConfig -> OCDConfig -> Bool
$c/= :: OCDConfig -> OCDConfig -> Bool
== :: OCDConfig -> OCDConfig -> Bool
$c== :: OCDConfig -> OCDConfig -> Bool
Eq, Eq OCDConfig
OCDConfig -> OCDConfig -> Bool
OCDConfig -> OCDConfig -> Ordering
OCDConfig -> OCDConfig -> OCDConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OCDConfig -> OCDConfig -> OCDConfig
$cmin :: OCDConfig -> OCDConfig -> OCDConfig
max :: OCDConfig -> OCDConfig -> OCDConfig
$cmax :: OCDConfig -> OCDConfig -> OCDConfig
>= :: OCDConfig -> OCDConfig -> Bool
$c>= :: OCDConfig -> OCDConfig -> Bool
> :: OCDConfig -> OCDConfig -> Bool
$c> :: OCDConfig -> OCDConfig -> Bool
<= :: OCDConfig -> OCDConfig -> Bool
$c<= :: OCDConfig -> OCDConfig -> Bool
< :: OCDConfig -> OCDConfig -> Bool
$c< :: OCDConfig -> OCDConfig -> Bool
compare :: OCDConfig -> OCDConfig -> Ordering
$ccompare :: OCDConfig -> OCDConfig -> Ordering
Ord, Int -> OCDConfig -> ShowS
[OCDConfig] -> ShowS
OCDConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OCDConfig] -> ShowS
$cshowList :: [OCDConfig] -> ShowS
show :: OCDConfig -> String
$cshow :: OCDConfig -> String
showsPrec :: Int -> OCDConfig -> ShowS
$cshowsPrec :: Int -> OCDConfig -> ShowS
Show)

instance Default OCDConfig where
  def :: OCDConfig
def =
    OCDConfig
      { ocdHost :: String
ocdHost = String
"127.0.0.1"
      , ocdPort :: Int
ocdPort = Int
6666
      }