{-# 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
  )
  where

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

import qualified Data.Bits.Pretty
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 = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ (a -> Doc AnsiStyle) -> [a] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc AnsiStyle
pp [a]
x

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

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

-- * Shorthand

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

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

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

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

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

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

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

displayISRs :: [Interrupt] -> String
displayISRs :: [Interrupt] -> String
displayISRs = Doc AnsiStyle -> String
displayPretty (Doc AnsiStyle -> String)
-> ([Interrupt] -> Doc AnsiStyle) -> [Interrupt] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interrupt -> Doc AnsiStyle) -> [Interrupt] -> Doc AnsiStyle
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
String
[Peripheral]
deviceName :: String
deviceVersion :: String
deviceDescription :: String
deviceAddressUnitBits :: Int
deviceWidth :: Int
deviceSize :: Int
deviceResetValue :: Int
deviceResetMask :: Int
devicePeripherals :: [Peripheral]
deviceName :: Device -> String
deviceVersion :: Device -> String
deviceDescription :: Device -> String
deviceAddressUnitBits :: Device -> Int
deviceWidth :: Device -> Int
deviceSize :: Device -> Int
deviceResetValue :: Device -> Int
deviceResetMask :: Device -> Int
devicePeripherals :: Device -> [Peripheral]
..} =
  (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
deviceName)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ((Peripheral -> Doc AnsiStyle) -> [Peripheral] -> Doc AnsiStyle
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
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphName :: String
periphDescription :: String
periphDerivedFrom :: Maybe String
periphGroupName :: String
periphBaseAddress :: Int
periphAddressBlock :: Maybe AddressBlock
periphInterrupts :: [Interrupt]
periphRegisters :: [Register]
periphClusters :: [Cluster]
periphName :: Peripheral -> String
periphDescription :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphGroupName :: Peripheral -> String
periphBaseAddress :: Peripheral -> Int
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphInterrupts :: Peripheral -> [Interrupt]
periphRegisters :: Peripheral -> [Register]
periphClusters :: Peripheral -> [Cluster]
..} =
      Doc AnsiStyle
forall ann. Doc ann
hardline
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)
        (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
periphName)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
White)
        (Int -> Doc AnsiStyle
ppHex Int
periphBaseAddress)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Magenta)
        (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
periphDescription)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
forall ann. Doc ann
line
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ((Register -> Doc AnsiStyle) -> [Register] -> Doc AnsiStyle
forall a. (a -> Doc AnsiStyle) -> [a] -> Doc AnsiStyle
ppList Register -> Doc AnsiStyle
ppReg [Register]
periphRegisters)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
-> (String -> Doc AnsiStyle) -> Maybe String -> Doc AnsiStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        Doc AnsiStyle
forall a. Monoid a => a
mempty
        (\String
x ->
          Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
           (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$   Doc AnsiStyle
forall ann. Doc ann
line
           Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String
"Derived from" :: String)
           Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
x
        )
        Maybe String
periphDerivedFrom

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

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

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

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

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

-- ** Interrupts

ppDevISR :: Device -> Doc AnsiStyle
ppDevISR :: Device -> Doc AnsiStyle
ppDevISR Device{Int
String
[Peripheral]
deviceName :: Device -> String
deviceVersion :: Device -> String
deviceDescription :: Device -> String
deviceAddressUnitBits :: Device -> Int
deviceWidth :: Device -> Int
deviceSize :: Device -> Int
deviceResetValue :: Device -> Int
deviceResetMask :: Device -> Int
devicePeripherals :: Device -> [Peripheral]
deviceName :: String
deviceVersion :: String
deviceDescription :: String
deviceAddressUnitBits :: Int
deviceWidth :: Int
deviceSize :: Int
deviceResetValue :: Int
deviceResetMask :: Int
devicePeripherals :: [Peripheral]
..} = (Peripheral -> Doc AnsiStyle) -> [Peripheral] -> Doc AnsiStyle
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
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphName :: Peripheral -> String
periphDescription :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphGroupName :: Peripheral -> String
periphBaseAddress :: Peripheral -> Int
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphInterrupts :: Peripheral -> [Interrupt]
periphRegisters :: Peripheral -> [Register]
periphClusters :: Peripheral -> [Cluster]
periphName :: String
periphDescription :: String
periphDerivedFrom :: Maybe String
periphGroupName :: String
periphBaseAddress :: Int
periphAddressBlock :: Maybe AddressBlock
periphInterrupts :: [Interrupt]
periphRegisters :: [Register]
periphClusters :: [Cluster]
..} =
  Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ((Interrupt -> Doc AnsiStyle) -> [Interrupt] -> Doc AnsiStyle
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
String
interruptName :: String
interruptDescription :: String
interruptValue :: Int
interruptName :: Interrupt -> String
interruptDescription :: Interrupt -> String
interruptValue :: Interrupt -> Int
..} =
  Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
    (
          Doc AnsiStyle
"|"
      Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
interruptName
      Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
" -- " Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Int -> Doc AnsiStyle
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
interruptValue Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
interruptDescription
    )

-- ** Terse output

ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo Device{Int
String
[Peripheral]
deviceName :: Device -> String
deviceVersion :: Device -> String
deviceDescription :: Device -> String
deviceAddressUnitBits :: Device -> Int
deviceWidth :: Device -> Int
deviceSize :: Device -> Int
deviceResetValue :: Device -> Int
deviceResetMask :: Device -> Int
devicePeripherals :: Device -> [Peripheral]
deviceName :: String
deviceVersion :: String
deviceDescription :: String
deviceAddressUnitBits :: Int
deviceWidth :: Int
deviceSize :: Int
deviceResetValue :: Int
deviceResetMask :: Int
devicePeripherals :: [Peripheral]
..} =
     AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red)
       (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
deviceName)
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
       ((Peripheral -> Doc AnsiStyle) -> [Peripheral] -> Doc AnsiStyle
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
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphName :: Peripheral -> String
periphDescription :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphGroupName :: Peripheral -> String
periphBaseAddress :: Peripheral -> Int
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphInterrupts :: Peripheral -> [Interrupt]
periphRegisters :: Peripheral -> [Register]
periphClusters :: Peripheral -> [Cluster]
periphName :: String
periphDescription :: String
periphDerivedFrom :: Maybe String
periphGroupName :: String
periphBaseAddress :: Int
periphAddressBlock :: Maybe AddressBlock
periphInterrupts :: [Interrupt]
periphRegisters :: [Register]
periphClusters :: [Cluster]
..} =
  AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)
    (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
periphName)

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

-- ** MemMap

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