{-# LANGUAGE OverloadedStrings #-}
module Data.SVD.Pretty.Explore
  ( exploreRegister
  ) where

import Data.Bits (FiniteBits)
import Data.SVD.Types (Register(..), Field(..))
import Data.Word (Word8, Word16, Word32)
import Prettyprinter
import Prettyprinter.Render.Terminal (AnsiStyle, Color(..), bold, color)
import Text.Printf (PrintfArg)

import qualified Data.Bits.Pretty
import qualified Data.SVD.Pretty
import qualified Data.SVD.Pretty.Box
import qualified Data.SVD.Util

exploreRegister
  :: ( PrintfArg a
     , FiniteBits a
     , Show a
     , Integral a
     )
  => a
  -> Int
  -> Register
  -> IO ()
exploreRegister :: forall a.
(PrintfArg a, FiniteBits a, Show a, Integral a) =>
a -> Int -> Register -> IO ()
exploreRegister a
x Int
addr Register
reg =
    String -> IO ()
putStrLn
  forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> String
Data.SVD.Pretty.displayPretty
  forall a b. (a -> b) -> a -> b
$ forall a.
(PrintfArg a, FiniteBits a, Show a, Integral a) =>
a -> Int -> Register -> Doc AnsiStyle
exploreRegister' a
x Int
addr Register
reg

exploreRegister'
  :: ( PrintfArg a
     , FiniteBits a
     , Show a
     , Integral a
     )
  => a
  -> Int
  -> Register
  -> Doc AnsiStyle
exploreRegister' :: forall a.
(PrintfArg a, FiniteBits a, Show a, Integral a) =>
a -> Int -> Register -> Doc AnsiStyle
exploreRegister' a
x Int
addr Register
reg =
      Doc AnsiStyle
"Register"
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate
        (AnsiStyle
bold forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
color Color
Red)
        (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Register -> String
regName Register
reg)
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
"-"
  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 (Register -> String
regDescription Register
reg))
  forall a. Semigroup a => a -> a -> a
<>  forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<>  Doc AnsiStyle
"- Address"
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. ann -> Doc ann -> Doc ann
annotate
        (Color -> AnsiStyle
color Color
Blue)
        (forall a ann. Pretty a => a -> Doc ann
pretty
          (forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
addr :: Word32)
          )
        )
  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens
        (  Doc AnsiStyle
"including offset "
        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
               (forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex
                 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Register -> Int
regAddressOffset Register
reg) :: Word8)
               )
             )
        )
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> case a
x of
    a
0 -> Doc AnsiStyle
"(Just zeros)"
    a
_ ->
      forall ann. [Doc ann] -> Doc ann
vsep
      [ forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Green)
          (    Doc AnsiStyle
"DEC"
           forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty
                 (forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showDec a
x)
          )
      , forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Cyan)
          (    Doc AnsiStyle
"HEX"
           forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty
                 (forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex a
x)
          )
      , forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
White)
          (   Doc AnsiStyle
"BIN"
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty
                (forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showBin a
x)
          )
      , forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Yellow)
          (   Doc AnsiStyle
"BIN"
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"0b"
          forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty
               (forall b. (PrintfArg b, Num b, FiniteBits b) => Int -> b -> String
Data.Bits.Pretty.showBinGroups Int
4 a
x)
          )
      , forall a.
(Show a, Eq a, Num a, FiniteBits a, PrintfArg a, Integral a) =>
[(a, Field)] -> Doc AnsiStyle
prettySetFields
          (forall a. (Bits a, Num a) => a -> [Field] -> [(a, Field)]
Data.SVD.Util.getFieldValues
             a
x
             (Register -> [Field]
regFields Register
reg)
          )
      ]
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
  forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty
       (forall a.
(Bits a, Num a, Show a, Integral a) =>
[(a, Field)] -> String
Data.SVD.Pretty.Box.renderFields
          forall a b. (a -> b) -> a -> b
$ forall a. (Bits a, Num a) => a -> [Field] -> [(a, Field)]
Data.SVD.Util.getFieldValues
              a
x
              (Register -> [Field]
regFields Register
reg)
       )

-- | Print currently set (non-zero) fields
prettySetFields
  :: ( Show a
     , Eq a
     , Num a
     , FiniteBits a
     , PrintfArg a
     , Integral a
     )
  => [(a, Field)]
  -> Doc AnsiStyle
prettySetFields :: forall a.
(Show a, Eq a, Num a, FiniteBits a, PrintfArg a, Integral a) =>
[(a, Field)] -> Doc AnsiStyle
prettySetFields =
    forall ann. [Doc ann] -> Doc ann
vsep
  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, FiniteBits a, PrintfArg a, Integral a) =>
(a, Field) -> Doc AnsiStyle
prettySetField
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => [(a, Field)] -> [(a, Field)]
filterSet
  where
    -- | Filter fields with non zero value
    filterSet
      :: ( Eq a
         , Num a
         )
      => [(a, Field)]
      -> [(a, Field)]
    filterSet :: forall a. (Eq a, Num a) => [(a, Field)] -> [(a, Field)]
filterSet = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

prettySetField
  :: ( Show a
     , Eq a
     , Num a
     , FiniteBits a
     , PrintfArg a
     , Integral a
     )
  => (a, Field)
  -> Doc AnsiStyle
prettySetField :: forall a.
(Show a, Eq a, Num a, FiniteBits a, PrintfArg a, Integral a) =>
(a, Field) -> Doc AnsiStyle
prettySetField (a
_, Field
f) | Field -> Int
fieldBitWidth Field
f forall a. Eq a => a -> a -> Bool
== Int
1 =
  forall ann. [Doc ann] -> Doc ann
hcat
    [ Doc AnsiStyle
"Bit "
    , forall a ann. Pretty a => a -> Doc ann
pretty (Field -> Int
fieldBitOffset Field
f)
    , Doc AnsiStyle
" "
    , 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
$ Field -> String
fieldName Field
f)
    ]
prettySetField (a
v, Field
f) | Bool
otherwise =
  forall ann. [Doc ann] -> Doc ann
hcat
    [ Doc AnsiStyle
"Bits ["
    , forall a ann. Pretty a => a -> Doc ann
pretty (Field -> Int
fieldBitOffset Field
f)
    , Doc AnsiStyle
":"
    , forall a ann. Pretty a => a -> Doc ann
pretty (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)
    , Doc AnsiStyle
"]"
    , Doc AnsiStyle
" "
    , 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
$ Field -> String
fieldName Field
f)
    , Doc AnsiStyle
" value "
    , forall ann. ann -> Doc ann -> Doc ann
annotate
        (Color -> AnsiStyle
color Color
Magenta)
        (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall {t}. (Integral t, PrintfArg t, FiniteBits t) => t -> String
showFittingSize a
v)
    ]
  where
    showFittingSize :: t -> String
showFittingSize t
x | forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x forall a. Ord a => a -> a -> Bool
<= (forall a. Bounded a => a
maxBound :: Word8) =
      Int -> String
Data.Bits.Pretty.showHex8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x forall a. Ord a => a -> a -> Bool
<= (forall a. Bounded a => a
maxBound :: Word16) =
      Int -> String
Data.Bits.Pretty.showHex16 (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x forall a. Ord a => a -> a -> Bool
<= (forall a. Bounded a => a
maxBound :: Word32) =
      Int -> String
Data.Bits.Pretty.showHex32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | Bool
otherwise =
      forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex t
x