{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Data.SVD.Pretty
  (
  -- * Helpers
    ppList
  , displayPretty
  , displayCompact
  -- * Shorthand
  , displayDevice
  , displayDeviceInfo
  , displayPeripheral
  , displayRegister
  , displayMemMap
  , displayMemMapCompact
  , displayDevISR
  , displayISRs
  -- * Pretty printers
  , ppDevice
  , ppPeriph
  , ppReg
  , ppHex
  -- ** Interrupts
  , ppDevISR
  , ppISR
  -- ** Terse output
  , ppDeviceInfo
  , ppPeriphName
  , shortField
  -- ** MemMap
  , ppMem
  -- * Who knows
  , printSetFields
  , printSetField
  , showField
  , fieldRange
  , hexFieldVal
  )
  where

import Data.Char (toLower)
import Data.SVD.Types
import Data.Word
import Prettyprinter
import Prettyprinter.Render.String
import Prettyprinter.Render.Terminal (AnsiStyle, Color(..), color)

import qualified Data.Bits.Pretty
import qualified Data.SVD.Util
import qualified Data.Text
import qualified Prettyprinter.Render.Terminal

-- * Helpers

ppList :: (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList :: forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList a -> Doc AnsiStyle
pp [a]
x = forall ann. [Doc ann] -> Doc ann
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> Doc AnsiStyle
pp [a]
x

displayPretty :: Doc AnsiStyle -> String
displayPretty :: Doc AnsiStyle -> [Char]
displayPretty =
    Text -> [Char]
Data.Text.unpack
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream AnsiStyle -> Text
Prettyprinter.Render.Terminal.renderStrict
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

displayCompact :: Doc AnsiStyle -> String
displayCompact :: Doc AnsiStyle -> [Char]
displayCompact =
    forall ann. SimpleDocStream ann -> [Char]
renderString
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact

-- * Shorthand

displayDevice :: Device -> String
displayDevice :: Device -> [Char]
displayDevice = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Doc AnsiStyle
ppDevice

displayDeviceInfo :: Device -> String
displayDeviceInfo :: Device -> [Char]
displayDeviceInfo = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Doc AnsiStyle
ppDeviceInfo

displayPeripheral :: Peripheral -> String
displayPeripheral :: Peripheral -> [Char]
displayPeripheral = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> Doc AnsiStyle
ppPeriph

displayRegister :: Register -> String
displayRegister :: Register -> [Char]
displayRegister = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> Doc AnsiStyle
ppReg

displayMemMap :: [(String, String)] -> String
displayMemMap :: [([Char], [Char])] -> [Char]
displayMemMap = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList ([Char], [Char]) -> Doc AnsiStyle
ppMem

displayMemMapCompact :: [(String, String)] -> String
displayMemMapCompact :: [([Char], [Char])] -> [Char]
displayMemMapCompact = Doc AnsiStyle -> [Char]
displayCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList ([Char], [Char]) -> Doc AnsiStyle
ppMem

displayDevISR :: Device -> String
displayDevISR :: Device -> [Char]
displayDevISR = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Doc AnsiStyle
ppDevISR

displayISRs :: [Interrupt] -> String
displayISRs :: [Interrupt] -> [Char]
displayISRs = Doc AnsiStyle -> [Char]
displayPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Interrupt -> Doc AnsiStyle
ppISR

-- * Pretty printers

ppDevice :: Device -> Doc AnsiStyle
ppDevice :: Device -> Doc AnsiStyle
ppDevice Device{Int
[Char]
[Peripheral]
devicePeripherals :: Device -> [Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> [Char]
deviceVersion :: Device -> [Char]
deviceName :: Device -> [Char]
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: [Char]
deviceVersion :: [Char]
deviceName :: [Char]
..} =
  (forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty [Char]
deviceName)
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Peripheral -> Doc AnsiStyle
ppPeriph [Peripheral]
devicePeripherals)

ppPeriph :: Peripheral -> Doc AnsiStyle
ppPeriph :: Peripheral -> Doc AnsiStyle
ppPeriph Peripheral{Int
[Char]
[Register]
[Cluster]
[Interrupt]
Maybe [Char]
Maybe AddressBlock
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> [Char]
periphDerivedFrom :: Peripheral -> Maybe [Char]
periphDescription :: Peripheral -> [Char]
periphName :: Peripheral -> [Char]
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: [Char]
periphDerivedFrom :: Maybe [Char]
periphDescription :: [Char]
periphName :: [Char]
..} =
      forall ann. Doc ann
hardline
  forall a. Semigroup a => a -> a -> a
<>  forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)
        (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
periphName)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
White)
        (Int -> Doc AnsiStyle
ppHex Int
periphBaseAddress)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Magenta)
        (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
periphDescription)
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Register -> Doc AnsiStyle
ppReg [Register]
periphRegisters)
  forall a. Semigroup a => a -> a -> a
<>  forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        forall a. Monoid a => a
mempty
        (\[Char]
x ->
          forall ann. Int -> Doc ann -> Doc ann
indent Int
2
           forall a b. (a -> b) -> a -> b
$   forall ann. Doc ann
line
           forall a. Semigroup a => a -> a -> a
<>  forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"Derived from" :: String)
           forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty [Char]
x
        )
        Maybe [Char]
periphDerivedFrom

ppReg :: Register -> Doc AnsiStyle
ppReg :: Register -> Doc AnsiStyle
ppReg Register{Int
[Char]
[Field]
Maybe Int
Maybe Dimension
AccessType
regFields :: Register -> [Field]
regResetValue :: Register -> Maybe Int
regAccess :: Register -> AccessType
regSize :: Register -> Int
regAddressOffset :: Register -> Int
regDescription :: Register -> [Char]
regDimension :: Register -> Maybe Dimension
regDisplayName :: Register -> [Char]
regName :: Register -> [Char]
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: [Char]
regDimension :: Maybe Dimension
regDisplayName :: [Char]
regName :: [Char]
..} =
  forall ann. Doc ann
hardline
  forall a. Semigroup a => a -> a -> a
<>  forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Blue)
        (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
regName)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
White)
        (Int -> Doc AnsiStyle
ppHex Int
regAddressOffset)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Cyan)
        (forall a ann. Pretty a => a -> Doc ann
pretty Char
'-' forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
regDescription))
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Int -> Doc ann -> Doc ann
indent Int
2
        (forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Field -> Doc AnsiStyle
ppField [Field]
regFields)

ppHex :: Int -> Doc AnsiStyle
ppHex :: Int -> Doc AnsiStyle
ppHex = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. PrintfArg t => t -> [Char]
Data.Bits.Pretty.formatHex

rpad :: Int -> String -> String
rpad :: Int -> [Char] -> [Char]
rpad Int
m [Char]
xs = forall a. Int -> [a] -> [a]
take Int
m forall a b. (a -> b) -> a -> b
$ [Char]
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' '

ppField :: Field -> Doc AnsiStyle
ppField :: Field -> Doc AnsiStyle
ppField Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
..} =
      forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Green)
        (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
rpad Int
25 [Char]
fieldName)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"::" :: String)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Int -> Doc AnsiStyle
ppWidthPad Int
7 Int
fieldBitWidth
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate
        (Color -> AnsiStyle
color Color
Cyan)
        (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ [Char]
" -- " forall a. [a] -> [a] -> [a]
++ [Char]
fieldDescription)

ppWidthPad
  :: Int
  -> Int
  -> Doc AnsiStyle
ppWidthPad :: Int -> Int -> Doc AnsiStyle
ppWidthPad Int
m Int
1 = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
rpad Int
m [Char]
"Bit"
ppWidthPad Int
m Int
x = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
rpad Int
m forall a b. (a -> b) -> a -> b
$ [Char]
"Bits " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
x

-- ** Interrupts

ppDevISR :: Device -> Doc AnsiStyle
ppDevISR :: Device -> Doc AnsiStyle
ppDevISR Device{Int
[Char]
[Peripheral]
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: [Char]
deviceVersion :: [Char]
deviceName :: [Char]
devicePeripherals :: Device -> [Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> [Char]
deviceVersion :: Device -> [Char]
deviceName :: Device -> [Char]
..} = forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Peripheral -> Doc AnsiStyle
ppPeriphISR [Peripheral]
devicePeripherals

ppPeriphISR :: Peripheral -> Doc AnsiStyle
ppPeriphISR :: Peripheral -> Doc AnsiStyle
ppPeriphISR Peripheral{Int
[Char]
[Register]
[Cluster]
[Interrupt]
Maybe [Char]
Maybe AddressBlock
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: [Char]
periphDerivedFrom :: Maybe [Char]
periphDescription :: [Char]
periphName :: [Char]
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> [Char]
periphDerivedFrom :: Peripheral -> Maybe [Char]
periphDescription :: Peripheral -> [Char]
periphName :: Peripheral -> [Char]
..} =
  forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Interrupt -> Doc AnsiStyle
ppISR [Interrupt]
periphInterrupts)
--  <//> (maybe empty (\x -> string "Derived from" <+> string x) periphDerivedFrom)

ppISR :: Interrupt -> Doc AnsiStyle
ppISR :: Interrupt -> Doc AnsiStyle
ppISR Interrupt{Int
[Char]
interruptValue :: Interrupt -> Int
interruptDescription :: Interrupt -> [Char]
interruptName :: Interrupt -> [Char]
interruptValue :: Int
interruptDescription :: [Char]
interruptName :: [Char]
..} =
  forall ann. Int -> Doc ann -> Doc ann
indent Int
2
    (
          Doc AnsiStyle
"|"
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty [Char]
interruptName
      forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
" -- " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
interruptValue forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty [Char]
interruptDescription
    )

-- ** Terse output

ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo Device{Int
[Char]
[Peripheral]
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: [Char]
deviceVersion :: [Char]
deviceName :: [Char]
devicePeripherals :: Device -> [Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> [Char]
deviceVersion :: Device -> [Char]
deviceName :: Device -> [Char]
..} =
     forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red)
       (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
deviceName)
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2
       (forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Peripheral -> Doc AnsiStyle
ppPeriphName [Peripheral]
devicePeripherals)

ppPeriphName :: Peripheral -> Doc AnsiStyle
ppPeriphName :: Peripheral -> Doc AnsiStyle
ppPeriphName Peripheral{Int
[Char]
[Register]
[Cluster]
[Interrupt]
Maybe [Char]
Maybe AddressBlock
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: [Char]
periphDerivedFrom :: Maybe [Char]
periphDescription :: [Char]
periphName :: [Char]
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> [Char]
periphDerivedFrom :: Peripheral -> Maybe [Char]
periphDescription :: Peripheral -> [Char]
periphName :: Peripheral -> [Char]
..} =
  forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)
    (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
periphName)

shortField :: Field -> String
shortField :: Field -> [Char]
shortField Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
..} = [[Char]] -> [Char]
unwords [
  [Char]
fieldName
  , [Char]
"offset"
  , forall a. Show a => a -> [Char]
show Int
fieldBitOffset
  , [Char]
"width"
  , forall a. Show a => a -> [Char]
show Int
fieldBitWidth ]

-- ** MemMap

ppMem :: (String, String) -> Doc AnsiStyle
ppMem :: ([Char], [Char]) -> Doc AnsiStyle
ppMem ([Char]
addr, [Char]
periph) =
     forall ann. Doc ann
name forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" :: Integer"
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
name
  forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
" = "
  forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty [Char]
addr
  where
    name :: Doc ann
name = forall a ann. Pretty a => a -> Doc ann
pretty (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
periph) forall a. Semigroup a => a -> a -> a
<> Doc ann
"_periph_base"

-- | Print currently set (non-zero) fields
printSetFields :: (Show a, Eq a, Num a) => [(a, Field)] -> String
printSetFields :: forall a. (Show a, Eq a, Num a) => [(a, Field)] -> [Char]
printSetFields =
    [[Char]] -> [Char]
unlines
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (Show a, Eq a, Num a) => (a, Field) -> [Char]
printSetField
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => [(a, Field)] -> [(a, Field)]
Data.SVD.Util.filterSet

printSetField :: (Show a, Eq a, Num a) => (a, Field) -> String
printSetField :: forall a. (Show a, Eq a, Num a) => (a, Field) -> [Char]
printSetField (a
_, Field
f) | Field -> Int
fieldBitWidth Field
f forall a. Eq a => a -> a -> Bool
== Int
1 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"Bit ", forall a. Show a => a -> [Char]
show (Field -> Int
fieldBitOffset Field
f), [Char]
" ", Field -> [Char]
fieldName Field
f]
printSetField (a
v, Field
f) | Bool
otherwise = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    [Char]
"Bits ["
  , forall a. Show a => a -> [Char]
show (Field -> Int
fieldBitOffset Field
f)
  , [Char]
":"
  , forall a. Show a => a -> [Char]
show (Field -> Int
fieldBitOffset Field
f forall a. Num a => a -> a -> a
+ Field -> Int
fieldBitWidth Field
f forall a. Num a => a -> a -> a
- Int
1)
  , [Char]
"]"
  , [Char]
" "
  , Field -> [Char]
fieldName Field
f
  , [Char]
" value ", forall a. Show a => a -> [Char]
show a
v]

-- | Show `Field` with its range, e.g BRR[15:0] (16 bit wide)
showField :: Field -> String
showField :: Field -> [Char]
showField f :: Field
f@Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
..} | Bool
fieldReserved = [Char]
"◦" forall a. [a] -> [a] -> [a]
++ (Field -> [Char]
fieldRange Field
f)
showField f :: Field
f@Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
..} | Bool
otherwise = [Char]
fieldName forall a. [a] -> [a] -> [a]
++ (Field -> [Char]
fieldRange Field
f)

-- | Datasheeeet like
fieldRange :: Field -> String
fieldRange :: Field -> [Char]
fieldRange Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
..} | Int
fieldBitWidth forall a. Eq a => a -> a -> Bool
== Int
1 = [Char]
""
fieldRange Field{Bool
Int
[Char]
Maybe [Char]
Maybe Dimension
fieldRegType :: Maybe [Char]
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: [Char]
fieldName :: [Char]
fieldRegType :: Field -> Maybe [Char]
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> [Char]
fieldName :: Field -> [Char]
..} | Bool
otherwise = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"[", forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Int
fieldBitWidth forall a. Num a => a -> a -> a
- Int
1, [Char]
":0]"]

-- | Format field value in hex, padded according to `fieldBitWidth`
hexFieldVal :: (Integral x, Show x) => Field -> x -> String
hexFieldVal :: forall x. (Integral x, Show x) => Field -> x -> [Char]
hexFieldVal Field
_ x
0 = [Char]
"0"
hexFieldVal Field
f x
x | Field -> Int
fieldBitWidth Field
f forall a. Eq a => a -> a -> Bool
==  Int
1 = forall {a} {a}. (Eq a, Num a, IsString a, Show a) => a -> a
showBit x
x
  where
    showBit :: a -> a
showBit a
0 = a
"0"
    showBit a
1 = a
"1"
    showBit a
y = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Not a bit: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
y
hexFieldVal Field
f x
x | Field -> Int
fieldBitWidth Field
f forall a. Ord a => a -> a -> Bool
<=  Int
8 =
  forall t. (PrintfArg t, FiniteBits t) => t -> [Char]
Data.Bits.Pretty.showHex (forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x :: Word8)
hexFieldVal Field
f x
x | Field -> Int
fieldBitWidth Field
f forall a. Ord a => a -> a -> Bool
<= Int
16 =
  forall t. (PrintfArg t, FiniteBits t) => t -> [Char]
Data.Bits.Pretty.showHex (forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x :: Word16)
hexFieldVal Field
f x
x | Field -> Int
fieldBitWidth Field
f forall a. Ord a => a -> a -> Bool
<= Int
32 =
  forall t. (PrintfArg t, FiniteBits t) => t -> [Char]
Data.Bits.Pretty.showHex (forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x :: Word32)
hexFieldVal Field
_ x
x | Bool
otherwise =
  forall t. (PrintfArg t, FiniteBits t) => t -> [Char]
Data.Bits.Pretty.showHex (forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x :: Word64)