{-# LANGUAGE DeriveGeneric #-}

module Data.SVD.Types
  ( AccessType(..)
  , toAccessType
  , showAccessType
  , AddressBlock(..)
  , Cluster(..)
  , Device(..)
  , Dimension(..)
  , DimensionIndex(..)
  , Interrupt(..)
  , Peripheral(..)
  , Register(..)
  , Field(..)
  ) where

import Data.Default.Class (Default(def))
import Data.Serialize (Serialize)
import GHC.Generics (Generic)

data Device = Device {
    Device -> String
deviceName            :: String
  , Device -> String
deviceVersion         :: String
  , Device -> String
deviceDescription     :: String
  , Device -> Int
deviceAddressUnitBits :: Int
  , Device -> Int
deviceWidth           :: Int
  , Device -> Int
deviceSize            :: Int
  , Device -> Int
deviceResetValue      :: Int
  , Device -> Int
deviceResetMask       :: Int
  , Device -> [Peripheral]
devicePeripherals     :: [Peripheral]
  } deriving ((forall x. Device -> Rep Device x)
-> (forall x. Rep Device x -> Device) -> Generic Device
forall x. Rep Device x -> Device
forall x. Device -> Rep Device x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Device -> Rep Device x
from :: forall x. Device -> Rep Device x
$cto :: forall x. Rep Device x -> Device
to :: forall x. Rep Device x -> Device
Generic, Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
/= :: Device -> Device -> Bool
Eq, Eq Device
Eq Device =>
(Device -> Device -> Ordering)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Bool)
-> (Device -> Device -> Device)
-> (Device -> Device -> Device)
-> Ord Device
Device -> Device -> Bool
Device -> Device -> Ordering
Device -> Device -> Device
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
$ccompare :: Device -> Device -> Ordering
compare :: Device -> Device -> Ordering
$c< :: Device -> Device -> Bool
< :: Device -> Device -> Bool
$c<= :: Device -> Device -> Bool
<= :: Device -> Device -> Bool
$c> :: Device -> Device -> Bool
> :: Device -> Device -> Bool
$c>= :: Device -> Device -> Bool
>= :: Device -> Device -> Bool
$cmax :: Device -> Device -> Device
max :: Device -> Device -> Device
$cmin :: Device -> Device -> Device
min :: Device -> Device -> Device
Ord, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Device -> ShowS
showsPrec :: Int -> Device -> ShowS
$cshow :: Device -> String
show :: Device -> String
$cshowList :: [Device] -> ShowS
showList :: [Device] -> ShowS
Show)

instance Default Device where
  def :: Device
def = Device
    { deviceName :: String
deviceName            = String
"defaultDev"
    , deviceVersion :: String
deviceVersion         = String
forall a. Monoid a => a
mempty
    , deviceDescription :: String
deviceDescription     = String
forall a. Monoid a => a
mempty
    , deviceAddressUnitBits :: Int
deviceAddressUnitBits = Int
0
    , deviceWidth :: Int
deviceWidth           = Int
0
    , deviceSize :: Int
deviceSize            = Int
0
    , deviceResetValue :: Int
deviceResetValue      = Int
0
    , deviceResetMask :: Int
deviceResetMask       = Int
0
    , devicePeripherals :: [Peripheral]
devicePeripherals     = []
    }

instance Serialize Device

data Peripheral = Peripheral {
    Peripheral -> String
periphName         :: String
  , Peripheral -> String
periphDescription  :: String
  , Peripheral -> Maybe String
periphDerivedFrom  :: Maybe String
  , Peripheral -> String
periphGroupName    :: String
  , Peripheral -> Int
periphBaseAddress  :: Int
  , Peripheral -> Maybe AddressBlock
periphAddressBlock :: Maybe AddressBlock
  , Peripheral -> [Interrupt]
periphInterrupts   :: [Interrupt]
  , Peripheral -> [Register]
periphRegisters    :: [Register]
  , Peripheral -> [Cluster]
periphClusters     :: [Cluster]
  } deriving ((forall x. Peripheral -> Rep Peripheral x)
-> (forall x. Rep Peripheral x -> Peripheral) -> Generic Peripheral
forall x. Rep Peripheral x -> Peripheral
forall x. Peripheral -> Rep Peripheral x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Peripheral -> Rep Peripheral x
from :: forall x. Peripheral -> Rep Peripheral x
$cto :: forall x. Rep Peripheral x -> Peripheral
to :: forall x. Rep Peripheral x -> Peripheral
Generic, Peripheral -> Peripheral -> Bool
(Peripheral -> Peripheral -> Bool)
-> (Peripheral -> Peripheral -> Bool) -> Eq Peripheral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Peripheral -> Peripheral -> Bool
== :: Peripheral -> Peripheral -> Bool
$c/= :: Peripheral -> Peripheral -> Bool
/= :: Peripheral -> Peripheral -> Bool
Eq, Eq Peripheral
Eq Peripheral =>
(Peripheral -> Peripheral -> Ordering)
-> (Peripheral -> Peripheral -> Bool)
-> (Peripheral -> Peripheral -> Bool)
-> (Peripheral -> Peripheral -> Bool)
-> (Peripheral -> Peripheral -> Bool)
-> (Peripheral -> Peripheral -> Peripheral)
-> (Peripheral -> Peripheral -> Peripheral)
-> Ord Peripheral
Peripheral -> Peripheral -> Bool
Peripheral -> Peripheral -> Ordering
Peripheral -> Peripheral -> Peripheral
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
$ccompare :: Peripheral -> Peripheral -> Ordering
compare :: Peripheral -> Peripheral -> Ordering
$c< :: Peripheral -> Peripheral -> Bool
< :: Peripheral -> Peripheral -> Bool
$c<= :: Peripheral -> Peripheral -> Bool
<= :: Peripheral -> Peripheral -> Bool
$c> :: Peripheral -> Peripheral -> Bool
> :: Peripheral -> Peripheral -> Bool
$c>= :: Peripheral -> Peripheral -> Bool
>= :: Peripheral -> Peripheral -> Bool
$cmax :: Peripheral -> Peripheral -> Peripheral
max :: Peripheral -> Peripheral -> Peripheral
$cmin :: Peripheral -> Peripheral -> Peripheral
min :: Peripheral -> Peripheral -> Peripheral
Ord, Int -> Peripheral -> ShowS
[Peripheral] -> ShowS
Peripheral -> String
(Int -> Peripheral -> ShowS)
-> (Peripheral -> String)
-> ([Peripheral] -> ShowS)
-> Show Peripheral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Peripheral -> ShowS
showsPrec :: Int -> Peripheral -> ShowS
$cshow :: Peripheral -> String
show :: Peripheral -> String
$cshowList :: [Peripheral] -> ShowS
showList :: [Peripheral] -> ShowS
Show)

instance Default Peripheral where
  def :: Peripheral
def = Peripheral
    { periphName :: String
periphName         = String
"defaultPeriph"
    , periphDescription :: String
periphDescription  = String
forall a. Monoid a => a
mempty
    , periphDerivedFrom :: Maybe String
periphDerivedFrom  = Maybe String
forall a. Maybe a
Nothing
    , periphGroupName :: String
periphGroupName    = String
forall a. Monoid a => a
mempty
    , periphBaseAddress :: Int
periphBaseAddress  = Int
0
    , periphAddressBlock :: Maybe AddressBlock
periphAddressBlock = Maybe AddressBlock
forall a. Maybe a
Nothing
    , periphInterrupts :: [Interrupt]
periphInterrupts   = []
    , periphRegisters :: [Register]
periphRegisters    = []
    , periphClusters :: [Cluster]
periphClusters     = []
    }

instance Serialize Peripheral

data AddressBlock = AddressBlock {
    AddressBlock -> Int
addressBlockOffset :: Int
  , AddressBlock -> Int
addressBlockSize   :: Int
  , AddressBlock -> String
addressBlockUsage  :: String
  } deriving ((forall x. AddressBlock -> Rep AddressBlock x)
-> (forall x. Rep AddressBlock x -> AddressBlock)
-> Generic AddressBlock
forall x. Rep AddressBlock x -> AddressBlock
forall x. AddressBlock -> Rep AddressBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddressBlock -> Rep AddressBlock x
from :: forall x. AddressBlock -> Rep AddressBlock x
$cto :: forall x. Rep AddressBlock x -> AddressBlock
to :: forall x. Rep AddressBlock x -> AddressBlock
Generic, AddressBlock -> AddressBlock -> Bool
(AddressBlock -> AddressBlock -> Bool)
-> (AddressBlock -> AddressBlock -> Bool) -> Eq AddressBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressBlock -> AddressBlock -> Bool
== :: AddressBlock -> AddressBlock -> Bool
$c/= :: AddressBlock -> AddressBlock -> Bool
/= :: AddressBlock -> AddressBlock -> Bool
Eq, Eq AddressBlock
Eq AddressBlock =>
(AddressBlock -> AddressBlock -> Ordering)
-> (AddressBlock -> AddressBlock -> Bool)
-> (AddressBlock -> AddressBlock -> Bool)
-> (AddressBlock -> AddressBlock -> Bool)
-> (AddressBlock -> AddressBlock -> Bool)
-> (AddressBlock -> AddressBlock -> AddressBlock)
-> (AddressBlock -> AddressBlock -> AddressBlock)
-> Ord AddressBlock
AddressBlock -> AddressBlock -> Bool
AddressBlock -> AddressBlock -> Ordering
AddressBlock -> AddressBlock -> AddressBlock
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
$ccompare :: AddressBlock -> AddressBlock -> Ordering
compare :: AddressBlock -> AddressBlock -> Ordering
$c< :: AddressBlock -> AddressBlock -> Bool
< :: AddressBlock -> AddressBlock -> Bool
$c<= :: AddressBlock -> AddressBlock -> Bool
<= :: AddressBlock -> AddressBlock -> Bool
$c> :: AddressBlock -> AddressBlock -> Bool
> :: AddressBlock -> AddressBlock -> Bool
$c>= :: AddressBlock -> AddressBlock -> Bool
>= :: AddressBlock -> AddressBlock -> Bool
$cmax :: AddressBlock -> AddressBlock -> AddressBlock
max :: AddressBlock -> AddressBlock -> AddressBlock
$cmin :: AddressBlock -> AddressBlock -> AddressBlock
min :: AddressBlock -> AddressBlock -> AddressBlock
Ord, Int -> AddressBlock -> ShowS
[AddressBlock] -> ShowS
AddressBlock -> String
(Int -> AddressBlock -> ShowS)
-> (AddressBlock -> String)
-> ([AddressBlock] -> ShowS)
-> Show AddressBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressBlock -> ShowS
showsPrec :: Int -> AddressBlock -> ShowS
$cshow :: AddressBlock -> String
show :: AddressBlock -> String
$cshowList :: [AddressBlock] -> ShowS
showList :: [AddressBlock] -> ShowS
Show)

instance Serialize AddressBlock

data Interrupt = Interrupt {
    Interrupt -> String
interruptName        :: String
  , Interrupt -> String
interruptDescription :: String
  , Interrupt -> Int
interruptValue       :: Int
  } deriving ((forall x. Interrupt -> Rep Interrupt x)
-> (forall x. Rep Interrupt x -> Interrupt) -> Generic Interrupt
forall x. Rep Interrupt x -> Interrupt
forall x. Interrupt -> Rep Interrupt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Interrupt -> Rep Interrupt x
from :: forall x. Interrupt -> Rep Interrupt x
$cto :: forall x. Rep Interrupt x -> Interrupt
to :: forall x. Rep Interrupt x -> Interrupt
Generic, Interrupt -> Interrupt -> Bool
(Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Bool) -> Eq Interrupt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Interrupt -> Interrupt -> Bool
== :: Interrupt -> Interrupt -> Bool
$c/= :: Interrupt -> Interrupt -> Bool
/= :: Interrupt -> Interrupt -> Bool
Eq, Eq Interrupt
Eq Interrupt =>
(Interrupt -> Interrupt -> Ordering)
-> (Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Bool)
-> (Interrupt -> Interrupt -> Interrupt)
-> (Interrupt -> Interrupt -> Interrupt)
-> Ord Interrupt
Interrupt -> Interrupt -> Bool
Interrupt -> Interrupt -> Ordering
Interrupt -> Interrupt -> Interrupt
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
$ccompare :: Interrupt -> Interrupt -> Ordering
compare :: Interrupt -> Interrupt -> Ordering
$c< :: Interrupt -> Interrupt -> Bool
< :: Interrupt -> Interrupt -> Bool
$c<= :: Interrupt -> Interrupt -> Bool
<= :: Interrupt -> Interrupt -> Bool
$c> :: Interrupt -> Interrupt -> Bool
> :: Interrupt -> Interrupt -> Bool
$c>= :: Interrupt -> Interrupt -> Bool
>= :: Interrupt -> Interrupt -> Bool
$cmax :: Interrupt -> Interrupt -> Interrupt
max :: Interrupt -> Interrupt -> Interrupt
$cmin :: Interrupt -> Interrupt -> Interrupt
min :: Interrupt -> Interrupt -> Interrupt
Ord, Int -> Interrupt -> ShowS
[Interrupt] -> ShowS
Interrupt -> String
(Int -> Interrupt -> ShowS)
-> (Interrupt -> String)
-> ([Interrupt] -> ShowS)
-> Show Interrupt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interrupt -> ShowS
showsPrec :: Int -> Interrupt -> ShowS
$cshow :: Interrupt -> String
show :: Interrupt -> String
$cshowList :: [Interrupt] -> ShowS
showList :: [Interrupt] -> ShowS
Show)

instance Serialize Interrupt

data DimensionIndex
  = DimensionIndex_FromTo Int Int
  | DimensionIndex_List [String]
  deriving ((forall x. DimensionIndex -> Rep DimensionIndex x)
-> (forall x. Rep DimensionIndex x -> DimensionIndex)
-> Generic DimensionIndex
forall x. Rep DimensionIndex x -> DimensionIndex
forall x. DimensionIndex -> Rep DimensionIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DimensionIndex -> Rep DimensionIndex x
from :: forall x. DimensionIndex -> Rep DimensionIndex x
$cto :: forall x. Rep DimensionIndex x -> DimensionIndex
to :: forall x. Rep DimensionIndex x -> DimensionIndex
Generic, DimensionIndex -> DimensionIndex -> Bool
(DimensionIndex -> DimensionIndex -> Bool)
-> (DimensionIndex -> DimensionIndex -> Bool) -> Eq DimensionIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DimensionIndex -> DimensionIndex -> Bool
== :: DimensionIndex -> DimensionIndex -> Bool
$c/= :: DimensionIndex -> DimensionIndex -> Bool
/= :: DimensionIndex -> DimensionIndex -> Bool
Eq, Eq DimensionIndex
Eq DimensionIndex =>
(DimensionIndex -> DimensionIndex -> Ordering)
-> (DimensionIndex -> DimensionIndex -> Bool)
-> (DimensionIndex -> DimensionIndex -> Bool)
-> (DimensionIndex -> DimensionIndex -> Bool)
-> (DimensionIndex -> DimensionIndex -> Bool)
-> (DimensionIndex -> DimensionIndex -> DimensionIndex)
-> (DimensionIndex -> DimensionIndex -> DimensionIndex)
-> Ord DimensionIndex
DimensionIndex -> DimensionIndex -> Bool
DimensionIndex -> DimensionIndex -> Ordering
DimensionIndex -> DimensionIndex -> DimensionIndex
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
$ccompare :: DimensionIndex -> DimensionIndex -> Ordering
compare :: DimensionIndex -> DimensionIndex -> Ordering
$c< :: DimensionIndex -> DimensionIndex -> Bool
< :: DimensionIndex -> DimensionIndex -> Bool
$c<= :: DimensionIndex -> DimensionIndex -> Bool
<= :: DimensionIndex -> DimensionIndex -> Bool
$c> :: DimensionIndex -> DimensionIndex -> Bool
> :: DimensionIndex -> DimensionIndex -> Bool
$c>= :: DimensionIndex -> DimensionIndex -> Bool
>= :: DimensionIndex -> DimensionIndex -> Bool
$cmax :: DimensionIndex -> DimensionIndex -> DimensionIndex
max :: DimensionIndex -> DimensionIndex -> DimensionIndex
$cmin :: DimensionIndex -> DimensionIndex -> DimensionIndex
min :: DimensionIndex -> DimensionIndex -> DimensionIndex
Ord, Int -> DimensionIndex -> ShowS
[DimensionIndex] -> ShowS
DimensionIndex -> String
(Int -> DimensionIndex -> ShowS)
-> (DimensionIndex -> String)
-> ([DimensionIndex] -> ShowS)
-> Show DimensionIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DimensionIndex -> ShowS
showsPrec :: Int -> DimensionIndex -> ShowS
$cshow :: DimensionIndex -> String
show :: DimensionIndex -> String
$cshowList :: [DimensionIndex] -> ShowS
showList :: [DimensionIndex] -> ShowS
Show)

instance Serialize DimensionIndex

data Dimension = Dimension {
    Dimension -> Int
dimensionSize      :: Int
  , Dimension -> Int
dimensionIncrement :: Int
  , Dimension -> DimensionIndex
dimensionIndex     :: DimensionIndex
  } deriving ((forall x. Dimension -> Rep Dimension x)
-> (forall x. Rep Dimension x -> Dimension) -> Generic Dimension
forall x. Rep Dimension x -> Dimension
forall x. Dimension -> Rep Dimension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dimension -> Rep Dimension x
from :: forall x. Dimension -> Rep Dimension x
$cto :: forall x. Rep Dimension x -> Dimension
to :: forall x. Rep Dimension x -> Dimension
Generic, Dimension -> Dimension -> Bool
(Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool) -> Eq Dimension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dimension -> Dimension -> Bool
== :: Dimension -> Dimension -> Bool
$c/= :: Dimension -> Dimension -> Bool
/= :: Dimension -> Dimension -> Bool
Eq, Eq Dimension
Eq Dimension =>
(Dimension -> Dimension -> Ordering)
-> (Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Bool)
-> (Dimension -> Dimension -> Dimension)
-> (Dimension -> Dimension -> Dimension)
-> Ord Dimension
Dimension -> Dimension -> Bool
Dimension -> Dimension -> Ordering
Dimension -> Dimension -> Dimension
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
$ccompare :: Dimension -> Dimension -> Ordering
compare :: Dimension -> Dimension -> Ordering
$c< :: Dimension -> Dimension -> Bool
< :: Dimension -> Dimension -> Bool
$c<= :: Dimension -> Dimension -> Bool
<= :: Dimension -> Dimension -> Bool
$c> :: Dimension -> Dimension -> Bool
> :: Dimension -> Dimension -> Bool
$c>= :: Dimension -> Dimension -> Bool
>= :: Dimension -> Dimension -> Bool
$cmax :: Dimension -> Dimension -> Dimension
max :: Dimension -> Dimension -> Dimension
$cmin :: Dimension -> Dimension -> Dimension
min :: Dimension -> Dimension -> Dimension
Ord, Int -> Dimension -> ShowS
[Dimension] -> ShowS
Dimension -> String
(Int -> Dimension -> ShowS)
-> (Dimension -> String)
-> ([Dimension] -> ShowS)
-> Show Dimension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dimension -> ShowS
showsPrec :: Int -> Dimension -> ShowS
$cshow :: Dimension -> String
show :: Dimension -> String
$cshowList :: [Dimension] -> ShowS
showList :: [Dimension] -> ShowS
Show)

instance Serialize Dimension

-- | Cluster describes a sequence of neighboring registers within a peripheral.
-- A <cluster> specifies the addressOffset relative to the baseAddress of the grouping element.
-- All <register> elements within a <cluster> specify their addressOffset relative to the cluster base address
-- (<peripheral.baseAddress> + <cluster.addressOffset>).
data Cluster = Cluster {
    Cluster -> String
clusterName          :: String
  , Cluster -> Maybe Dimension
clusterDimension     :: Maybe Dimension
  , Cluster -> String
clusterDescription   :: String
  , Cluster -> Int
clusterAddressOffset :: Int
  , Cluster -> [Register]
clusterRegisters     :: [Register]
  -- unused, expansion not yet implemented
  -- but also not quite present in any SVD we've seen
  , Cluster -> [Cluster]
clusterNested        :: [Cluster]
  } deriving ((forall x. Cluster -> Rep Cluster x)
-> (forall x. Rep Cluster x -> Cluster) -> Generic Cluster
forall x. Rep Cluster x -> Cluster
forall x. Cluster -> Rep Cluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cluster -> Rep Cluster x
from :: forall x. Cluster -> Rep Cluster x
$cto :: forall x. Rep Cluster x -> Cluster
to :: forall x. Rep Cluster x -> Cluster
Generic, Cluster -> Cluster -> Bool
(Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool) -> Eq Cluster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cluster -> Cluster -> Bool
== :: Cluster -> Cluster -> Bool
$c/= :: Cluster -> Cluster -> Bool
/= :: Cluster -> Cluster -> Bool
Eq, Eq Cluster
Eq Cluster =>
(Cluster -> Cluster -> Ordering)
-> (Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Cluster)
-> (Cluster -> Cluster -> Cluster)
-> Ord Cluster
Cluster -> Cluster -> Bool
Cluster -> Cluster -> Ordering
Cluster -> Cluster -> Cluster
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
$ccompare :: Cluster -> Cluster -> Ordering
compare :: Cluster -> Cluster -> Ordering
$c< :: Cluster -> Cluster -> Bool
< :: Cluster -> Cluster -> Bool
$c<= :: Cluster -> Cluster -> Bool
<= :: Cluster -> Cluster -> Bool
$c> :: Cluster -> Cluster -> Bool
> :: Cluster -> Cluster -> Bool
$c>= :: Cluster -> Cluster -> Bool
>= :: Cluster -> Cluster -> Bool
$cmax :: Cluster -> Cluster -> Cluster
max :: Cluster -> Cluster -> Cluster
$cmin :: Cluster -> Cluster -> Cluster
min :: Cluster -> Cluster -> Cluster
Ord, Int -> Cluster -> ShowS
[Cluster] -> ShowS
Cluster -> String
(Int -> Cluster -> ShowS)
-> (Cluster -> String) -> ([Cluster] -> ShowS) -> Show Cluster
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cluster -> ShowS
showsPrec :: Int -> Cluster -> ShowS
$cshow :: Cluster -> String
show :: Cluster -> String
$cshowList :: [Cluster] -> ShowS
showList :: [Cluster] -> ShowS
Show)

instance Default Cluster where
  def :: Cluster
def = Cluster
    { clusterName :: String
clusterName          = String
"defaultCluster"
    , clusterDescription :: String
clusterDescription   = String
forall a. Monoid a => a
mempty
    , clusterDimension :: Maybe Dimension
clusterDimension     = Maybe Dimension
forall a. Maybe a
Nothing
    , clusterAddressOffset :: Int
clusterAddressOffset = Int
0
    , clusterRegisters :: [Register]
clusterRegisters     = []
    , clusterNested :: [Cluster]
clusterNested        = []
    }

instance Serialize Cluster

data Register = Register {
    Register -> String
regName          :: String
  , Register -> String
regDisplayName   :: String
  , Register -> Maybe Dimension
regDimension     :: Maybe Dimension
  , Register -> String
regDescription   :: String
  , Register -> Int
regAddressOffset :: Int
  , Register -> Int
regSize          :: Int
  , Register -> AccessType
regAccess        :: AccessType
  , Register -> Maybe Int
regResetValue    :: Maybe Int
  , Register -> [Field]
regFields        :: [Field]
  } deriving ((forall x. Register -> Rep Register x)
-> (forall x. Rep Register x -> Register) -> Generic Register
forall x. Rep Register x -> Register
forall x. Register -> Rep Register x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Register -> Rep Register x
from :: forall x. Register -> Rep Register x
$cto :: forall x. Rep Register x -> Register
to :: forall x. Rep Register x -> Register
Generic, Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
/= :: Register -> Register -> Bool
Eq, Eq Register
Eq Register =>
(Register -> Register -> Ordering)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Register)
-> (Register -> Register -> Register)
-> Ord Register
Register -> Register -> Bool
Register -> Register -> Ordering
Register -> Register -> Register
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
$ccompare :: Register -> Register -> Ordering
compare :: Register -> Register -> Ordering
$c< :: Register -> Register -> Bool
< :: Register -> Register -> Bool
$c<= :: Register -> Register -> Bool
<= :: Register -> Register -> Bool
$c> :: Register -> Register -> Bool
> :: Register -> Register -> Bool
$c>= :: Register -> Register -> Bool
>= :: Register -> Register -> Bool
$cmax :: Register -> Register -> Register
max :: Register -> Register -> Register
$cmin :: Register -> Register -> Register
min :: Register -> Register -> Register
Ord, Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Register -> ShowS
showsPrec :: Int -> Register -> ShowS
$cshow :: Register -> String
show :: Register -> String
$cshowList :: [Register] -> ShowS
showList :: [Register] -> ShowS
Show)

instance Default Register where
  def :: Register
def = Register
    { regName :: String
regName          = String
"defaultRegister"
    , regDisplayName :: String
regDisplayName   = String
forall a. Monoid a => a
mempty
    , regDimension :: Maybe Dimension
regDimension     = Maybe Dimension
forall a. Maybe a
Nothing
    , regDescription :: String
regDescription   = String
forall a. Monoid a => a
mempty
    , regAddressOffset :: Int
regAddressOffset = Int
0
    , regSize :: Int
regSize          = Int
0
    , regAccess :: AccessType
regAccess        = AccessType
ReadOnly
    , regResetValue :: Maybe Int
regResetValue    = Maybe Int
forall a. Maybe a
Nothing
    , regFields :: [Field]
regFields        = []
    }

instance Serialize Register

data AccessType
  = ReadOnly
  | WriteOnly
  | ReadWrite
  | WriteOnce
  | ReadWriteOnce
  deriving ((forall x. AccessType -> Rep AccessType x)
-> (forall x. Rep AccessType x -> AccessType) -> Generic AccessType
forall x. Rep AccessType x -> AccessType
forall x. AccessType -> Rep AccessType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccessType -> Rep AccessType x
from :: forall x. AccessType -> Rep AccessType x
$cto :: forall x. Rep AccessType x -> AccessType
to :: forall x. Rep AccessType x -> AccessType
Generic, AccessType -> AccessType -> Bool
(AccessType -> AccessType -> Bool)
-> (AccessType -> AccessType -> Bool) -> Eq AccessType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessType -> AccessType -> Bool
== :: AccessType -> AccessType -> Bool
$c/= :: AccessType -> AccessType -> Bool
/= :: AccessType -> AccessType -> Bool
Eq, Eq AccessType
Eq AccessType =>
(AccessType -> AccessType -> Ordering)
-> (AccessType -> AccessType -> Bool)
-> (AccessType -> AccessType -> Bool)
-> (AccessType -> AccessType -> Bool)
-> (AccessType -> AccessType -> Bool)
-> (AccessType -> AccessType -> AccessType)
-> (AccessType -> AccessType -> AccessType)
-> Ord AccessType
AccessType -> AccessType -> Bool
AccessType -> AccessType -> Ordering
AccessType -> AccessType -> AccessType
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
$ccompare :: AccessType -> AccessType -> Ordering
compare :: AccessType -> AccessType -> Ordering
$c< :: AccessType -> AccessType -> Bool
< :: AccessType -> AccessType -> Bool
$c<= :: AccessType -> AccessType -> Bool
<= :: AccessType -> AccessType -> Bool
$c> :: AccessType -> AccessType -> Bool
> :: AccessType -> AccessType -> Bool
$c>= :: AccessType -> AccessType -> Bool
>= :: AccessType -> AccessType -> Bool
$cmax :: AccessType -> AccessType -> AccessType
max :: AccessType -> AccessType -> AccessType
$cmin :: AccessType -> AccessType -> AccessType
min :: AccessType -> AccessType -> AccessType
Ord, Int -> AccessType -> ShowS
[AccessType] -> ShowS
AccessType -> String
(Int -> AccessType -> ShowS)
-> (AccessType -> String)
-> ([AccessType] -> ShowS)
-> Show AccessType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessType -> ShowS
showsPrec :: Int -> AccessType -> ShowS
$cshow :: AccessType -> String
show :: AccessType -> String
$cshowList :: [AccessType] -> ShowS
showList :: [AccessType] -> ShowS
Show)

instance Serialize AccessType

data Field = Field {
    Field -> String
fieldName        :: String
  , Field -> String
fieldDescription :: String
  , Field -> Maybe Dimension
fieldDimension   :: Maybe Dimension
  , Field -> Int
fieldBitOffset   :: Int
  , Field -> Int
fieldBitWidth    :: Int
  , Field -> Bool
fieldReserved    :: Bool  -- so we can add reserved fields to the list
  , Field -> Maybe String
fieldRegType     :: Maybe String  -- ivory register type
  } deriving ((forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Field -> Rep Field x
from :: forall x. Field -> Rep Field x
$cto :: forall x. Rep Field x -> Field
to :: forall x. Rep Field x -> Field
Generic, Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq, Eq Field
Eq Field =>
(Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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
$ccompare :: Field -> Field -> Ordering
compare :: Field -> Field -> Ordering
$c< :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
>= :: Field -> Field -> Bool
$cmax :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
min :: Field -> Field -> Field
Ord, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show)

instance Default Field where
  def :: Field
def = Field
    { fieldName :: String
fieldName        = String
"defaultField"
    , fieldDescription :: String
fieldDescription = String
forall a. Monoid a => a
mempty
    , fieldDimension :: Maybe Dimension
fieldDimension   = Maybe Dimension
forall a. Maybe a
Nothing
    , fieldBitOffset :: Int
fieldBitOffset   = Int
0
    , fieldBitWidth :: Int
fieldBitWidth    = Int
0
    , fieldReserved :: Bool
fieldReserved    = Bool
False
    , fieldRegType :: Maybe String
fieldRegType     = Maybe String
forall a. Maybe a
Nothing
    }

instance Serialize Field

toAccessType :: String -> AccessType
toAccessType :: String -> AccessType
toAccessType String
"read-only"      = AccessType
ReadOnly
toAccessType String
"write-only"     = AccessType
WriteOnly
toAccessType String
"read-write"     = AccessType
ReadWrite
toAccessType String
"writeOnce"      = AccessType
WriteOnce
toAccessType String
"read-writeOnce" = AccessType
ReadWriteOnce
toAccessType String
x                = String -> AccessType
forall a. HasCallStack => String -> a
error (String -> AccessType) -> String -> AccessType
forall a b. (a -> b) -> a -> b
$ String
"Unable to read AccessType" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

showAccessType :: AccessType -> String
showAccessType :: AccessType -> String
showAccessType AccessType
ReadOnly       = String
"read-only"
showAccessType AccessType
WriteOnly      = String
"write-only"
showAccessType AccessType
ReadWrite      = String
"read-write"
showAccessType AccessType
WriteOnce      = String
"writeOnce"
showAccessType AccessType
ReadWriteOnce  = String
"read-writeOnce"