{-# 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
  (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> String
Data.SVD.Pretty.displayPretty
  (Doc AnsiStyle -> String) -> Doc AnsiStyle -> String
forall a b. (a -> b) -> a -> b
$ a -> Int -> Register -> Doc AnsiStyle
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"
  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
        (AnsiStyle
bold AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Color -> AnsiStyle
color Color
Red)
        (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
$ Register -> String
regName Register
reg)
  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
"-"
  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 (Register -> String
regDescription Register
reg))
  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
"- Address"
  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
Blue)
        (String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
          (Word32 -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex
            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
addr :: Word32)
          )
        )
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann
parens
        (  Doc AnsiStyle
"including offset "
        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
               (Word8 -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex
                 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Register -> Int
regAddressOffset Register
reg) :: Word8)
               )
             )
        )
  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
line
  Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> case a
x of
    a
0 -> Doc AnsiStyle
"(Just zeros)"
    a
_ ->
      [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
      [ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Green)
          (    Doc AnsiStyle
"DEC"
           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
                 (a -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showDec a
x)
          )
      , AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Cyan)
          (    Doc AnsiStyle
"HEX"
           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
                 (a -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex a
x)
          )
      , AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
White)
          (   Doc AnsiStyle
"BIN"
          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
                (a -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showBin a
x)
          )
      , AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate
          (Color -> AnsiStyle
color Color
Yellow)
          (   Doc AnsiStyle
"BIN"
          Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"0b"
          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
               (Int -> a -> String
forall b. (PrintfArg b, Num b, FiniteBits b) => Int -> b -> String
Data.Bits.Pretty.showBinGroups Int
4 a
x)
          )
      , [(a, Field)] -> Doc AnsiStyle
forall a.
(Show a, Eq a, Num a, FiniteBits a, PrintfArg a, Integral a) =>
[(a, Field)] -> Doc AnsiStyle
prettySetFields
          (a -> [Field] -> [(a, Field)]
forall a. (Bits a, Num a) => a -> [Field] -> [(a, Field)]
Data.SVD.Util.getFieldValues
             a
x
             (Register -> [Field]
regFields Register
reg)
          )
      ]
  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
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
       ([(a, Field)] -> String
forall a.
(Bits a, Num a, Show a, Integral a) =>
[(a, Field)] -> String
Data.SVD.Pretty.Box.renderFields
          ([(a, Field)] -> String) -> [(a, Field)] -> String
forall a b. (a -> b) -> a -> b
$ a -> [Field] -> [(a, Field)]
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 =
    [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep
  ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([(a, Field)] -> [Doc AnsiStyle])
-> [(a, Field)]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Field) -> Doc AnsiStyle) -> [(a, Field)] -> [Doc AnsiStyle]
forall a b. (a -> b) -> [a] -> [b]
map (a, Field) -> Doc AnsiStyle
forall a.
(Show a, Eq a, Num a, FiniteBits a, PrintfArg a, Integral a) =>
(a, Field) -> Doc AnsiStyle
prettySetField
  ([(a, Field)] -> [Doc AnsiStyle])
-> ([(a, Field)] -> [(a, Field)])
-> [(a, Field)]
-> [Doc AnsiStyle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Field)] -> [(a, Field)]
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 = ((a, Field) -> Bool) -> [(a, Field)] -> [(a, Field)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0) (a -> Bool) -> ((a, Field) -> a) -> (a, Field) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Field) -> a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
  [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat
    [ Doc AnsiStyle
"Bit "
    , Int -> Doc AnsiStyle
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Field -> Int
fieldBitOffset Field
f)
    , Doc AnsiStyle
" "
    , 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
$ Field -> String
fieldName Field
f)
    ]
prettySetField (a
v, Field
f) | Bool
otherwise =
  [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
hcat
    [ Doc AnsiStyle
"Bits ["
    , Int -> Doc AnsiStyle
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Field -> Int
fieldBitOffset Field
f)
    , Doc AnsiStyle
":"
    , Int -> Doc AnsiStyle
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Field -> Int
fieldBitOffset Field
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Field -> Int
fieldBitWidth Field
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    , Doc AnsiStyle
"]"
    , Doc AnsiStyle
" "
    , 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
$ Field -> String
fieldName Field
f)
    , Doc AnsiStyle
" value "
    , 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 -> Doc AnsiStyle) -> String -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ a -> String
forall {t}. (Integral t, PrintfArg t, FiniteBits t) => t -> String
showFittingSize a
v)
    ]
  where
    showFittingSize :: t -> String
showFittingSize t
x | t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word8
forall a. Bounded a => a
maxBound :: Word8) =
      Int -> String
Data.Bits.Pretty.showHex8 (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | t -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word16
forall a. Bounded a => a
maxBound :: Word16) =
      Int -> String
Data.Bits.Pretty.showHex16 (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | t -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= (Word32
forall a. Bounded a => a
maxBound :: Word32) =
      Int -> String
Data.Bits.Pretty.showHex32 (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
x)
    showFittingSize t
x | Bool
otherwise =
      t -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
Data.Bits.Pretty.showHex t
x