{-# 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 = 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 -> String
displayPretty =
    Text -> String
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 -> String
displayCompact =
    forall ann. SimpleDocStream ann -> String
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 -> String
displayDevice = Doc AnsiStyle -> String
displayPretty 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 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 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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
String
[Peripheral]
devicePeripherals :: Device -> [Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> String
deviceVersion :: Device -> String
deviceName :: Device -> String
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: String
deviceVersion :: String
deviceName :: String
..} =
  (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 String
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
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphDescription :: Peripheral -> String
periphName :: Peripheral -> String
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: String
periphDerivedFrom :: Maybe String
periphDescription :: String
periphName :: String
..} =
      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 String
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 String
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
        (\String
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 (String
"Derived from" :: String)
           forall ann. Doc ann -> Doc ann -> 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
regFields :: Register -> [Field]
regResetValue :: Register -> Maybe Int
regAccess :: Register -> AccessType
regSize :: Register -> Int
regAddressOffset :: Register -> Int
regDescription :: Register -> String
regDimension :: Register -> Maybe Dimension
regDisplayName :: Register -> String
regName :: Register -> String
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: String
regDimension :: Maybe Dimension
regDisplayName :: String
regName :: String
..} =
  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 String
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 String
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 -> String
Data.Bits.Pretty.formatHex

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

ppField :: Field -> Doc AnsiStyle
ppField :: Field -> Doc AnsiStyle
ppField Field{Bool
Int
String
Maybe String
Maybe Dimension
fieldRegType :: Field -> Maybe String
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> String
fieldName :: Field -> String
fieldRegType :: Maybe String
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: String
fieldName :: String
..} =
      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 -> String -> String
rpad Int
25 String
fieldName)
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (String
"::" :: 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
$ String
" -- " forall a. [a] -> [a] -> [a]
++ String
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 -> String -> String
rpad Int
m String
"Bit"
ppWidthPad Int
m Int
x = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Int -> String -> String
rpad Int
m forall a b. (a -> b) -> a -> b
$ String
"Bits " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
x

-- ** Interrupts

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

-- ** Terse output

ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo :: Device -> Doc AnsiStyle
ppDeviceInfo Device{Int
String
[Peripheral]
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: String
deviceVersion :: String
deviceName :: String
devicePeripherals :: Device -> [Peripheral]
deviceResetMask :: Device -> Int
deviceResetValue :: Device -> Int
deviceSize :: Device -> Int
deviceWidth :: Device -> Int
deviceAddressUnitBits :: Device -> Int
deviceDescription :: Device -> String
deviceVersion :: Device -> String
deviceName :: Device -> String
..} =
     forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red)
       (forall a ann. Pretty a => a -> Doc ann
pretty String
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
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: String
periphDerivedFrom :: Maybe String
periphDescription :: String
periphName :: String
periphClusters :: Peripheral -> [Cluster]
periphRegisters :: Peripheral -> [Register]
periphInterrupts :: Peripheral -> [Interrupt]
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphBaseAddress :: Peripheral -> Int
periphGroupName :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphDescription :: Peripheral -> String
periphName :: Peripheral -> String
..} =
  forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow)
    (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
fieldRegType :: Maybe String
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: String
fieldName :: String
fieldRegType :: Field -> Maybe String
fieldReserved :: Field -> Bool
fieldBitWidth :: Field -> Int
fieldBitOffset :: Field -> Int
fieldDimension :: Field -> Maybe Dimension
fieldDescription :: Field -> String
fieldName :: Field -> String
..} = [String] -> String
unwords [
  String
fieldName
  , String
"offset"
  , forall a. Show a => a -> String
show Int
fieldBitOffset
  , String
"width"
  , 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) =
     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 String
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 String
periph) forall a. Semigroup a => a -> a -> a
<> Doc ann
"_periph_base"