diff --git a/src/Data/SVD/Pretty/Box.hs b/src/Data/SVD/Pretty/Box.hs index 2733007..8c27f54 100644 --- a/src/Data/SVD/Pretty/Box.hs +++ b/src/Data/SVD/Pretty/Box.hs @@ -7,11 +7,14 @@ module Data.SVD.Pretty.Box import Data.Bits (Bits()) import Data.SVD.Types (Field(..)) import Data.Word (Word8, Word16, Word32, Word64) +import Prettyprinter +import Prettyprinter.Render.Terminal (Color(..), color) import Text.PrettyPrint.Boxes (Box, (//)) import qualified Text.PrettyPrint.Boxes import qualified Data.List import qualified Data.Bits.Pretty +import qualified Data.SVD.Pretty -- | Render fields as table using boxes -- If table would be too wide split it into two tables @@ -21,20 +24,28 @@ renderFields , Show a , Integral a) => [(a, Field)] - -> IO () + -> String renderFields fs | headerSize >= 80 = do - putStrLn "MSB" - putStrLn - $ Text.PrettyPrint.Boxes.render - $ table - $ remap - $ takeBits 16 fs - putStrLn "LSB" - putStrLn - $ Text.PrettyPrint.Boxes.render - $ table - $ remap - $ dropBits 16 fs + Data.SVD.Pretty.displayPretty + ( annotate (color Yellow) + (pretty "MSB") + <> line + ) + <> Text.PrettyPrint.Boxes.render + ( table + . remap + $ takeBits 16 fs + ) + <> Data.SVD.Pretty.displayPretty + ( annotate (color Magenta) + (pretty "LSB") + <> line + ) + <> Text.PrettyPrint.Boxes.render + ( table + . remap + $ dropBits 16 fs + ) where headerSize = sum @@ -43,8 +54,7 @@ renderFields fs | headerSize >= 80 = do fs renderFields fs | otherwise = - putStrLn - . Text.PrettyPrint.Boxes.render + Text.PrettyPrint.Boxes.render . table . remap $ fs @@ -83,10 +93,10 @@ fmtColumn items = items ) // vSepDeco - where width = maximum $ map length items + where width' = maximum $ map length items vSepDeco = Text.PrettyPrint.Boxes.text - $ replicate width '-' + $ replicate width' '-' remap :: ( Integral x diff --git a/src/Data/SVD/Pretty/Explore.hs b/src/Data/SVD/Pretty/Explore.hs index 1bba989..16d2a9b 100644 --- a/src/Data/SVD/Pretty/Explore.hs +++ b/src/Data/SVD/Pretty/Explore.hs @@ -1,13 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} module Data.SVD.Pretty.Explore ( exploreRegister ) where import Data.Bits (FiniteBits) import Data.SVD.Types (Register(..), Field(..)) -import Data.Word (Word8, Word32) +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 @@ -21,64 +25,110 @@ exploreRegister -> Int -> Register -> IO () -exploreRegister x addr reg = do - putStrLn - $ "Register " ++ regName reg - putStrLn - $ "- " ++ regDescription reg +exploreRegister x addr reg = + putStrLn + $ Data.SVD.Pretty.displayPretty + $ exploreRegister' x addr reg - let addrW32 = - Data.Bits.Pretty.showHex - (fromIntegral addr :: Word32) - addrWithOffset = - Data.Bits.Pretty.showHex - (fromIntegral (regAddressOffset reg) :: Word8) - - putStrLn - $ "- Address " - <> addrW32 - <> " (including offset " - <> addrWithOffset - <> ")" - putStrLn "" - - case x of - 0 -> putStrLn "(Just zeros)" - _ -> do - - putStrLn - $ Data.Bits.Pretty.showDec x - putStrLn - $ Data.Bits.Pretty.showHex x - putStrLn - $ Data.Bits.Pretty.showBin x - putStrLn - $ "0b" - <> Data.Bits.Pretty.showBinGroups 4 x - - putStrLn - $ printSetFields - $ Data.SVD.Util.getFieldValues - x - (regFields reg) - - putStrLn "" - Data.SVD.Pretty.Box.renderFields - $ Data.SVD.Util.getFieldValues - x - (regFields reg) +exploreRegister' + :: ( PrintfArg a + , FiniteBits a + , Show a + , Integral a + ) + => a + -> Int + -> Register + -> Doc AnsiStyle +exploreRegister' x addr reg = + "Register" + <+> annotate + (bold <> color Red) + (pretty $ regName reg) + <> line + <> "-" + <+> annotate + (color Magenta) + (pretty (regDescription reg)) + <> line + <> "- Address" + <+> annotate + (color Blue) + (pretty + (Data.Bits.Pretty.showHex + (fromIntegral addr :: Word32) + ) + ) + <+> parens + ( "including offset " + <> annotate + (color Blue) + (pretty + (Data.Bits.Pretty.showHex + (fromIntegral (regAddressOffset reg) :: Word8) + ) + ) + ) + <> line + <> line + <> case x of + 0 -> "(Just zeros)" + _ -> + vsep + [ annotate + (color Green) + ( "DEC" + <+> pretty + (Data.Bits.Pretty.showDec x) + ) + , annotate + (color Cyan) + ( "HEX" + <+> pretty + (Data.Bits.Pretty.showHex x) + ) + , annotate + (color White) + ( "BIN" + <+> pretty + (Data.Bits.Pretty.showBin x) + ) + , annotate + (color Yellow) + ( "BIN" + <+> "0b" + <> pretty + (Data.Bits.Pretty.showBinGroups 4 x) + ) + , prettySetFields + (Data.SVD.Util.getFieldValues + x + (regFields reg) + ) + ] + <> line + <> line + <> pretty + (Data.SVD.Pretty.Box.renderFields + $ Data.SVD.Util.getFieldValues + x + (regFields reg) + ) -- | Print currently set (non-zero) fields -printSetFields +prettySetFields :: ( Show a , Eq a , Num a + , FiniteBits a + , PrintfArg a + , Integral a ) => [(a, Field)] - -> String -printSetFields = - unlines - . map printSetField + -> Doc AnsiStyle +prettySetFields = + vsep + . map prettySetField . filterSet where -- | Filter fields with non zero value @@ -90,28 +140,47 @@ printSetFields = -> [(a, Field)] filterSet = filter ((/= 0) . fst) -printSetField +prettySetField :: ( Show a , Eq a , Num a + , FiniteBits a + , PrintfArg a + , Integral a ) => (a, Field) - -> String -printSetField (_, f) | fieldBitWidth f == 1 = - concat + -> Doc AnsiStyle +prettySetField (_, f) | fieldBitWidth f == 1 = + hcat [ "Bit " - , show (fieldBitOffset f) + , pretty (fieldBitOffset f) , " " - , fieldName f + , annotate + (color Cyan) + (pretty $ fieldName f) ] -printSetField (v, f) | otherwise = - concat +prettySetField (v, f) | otherwise = + hcat [ "Bits [" - , show (fieldBitOffset f) + , pretty (fieldBitOffset f) , ":" - , show (fieldBitOffset f + fieldBitWidth f - 1) + , pretty (fieldBitOffset f + fieldBitWidth f - 1) , "]" , " " - , fieldName f - , " value ", show v + , annotate + (color Cyan) + (pretty $ fieldName f) + , " value " + , annotate + (color Magenta) + (pretty $ showFittingSize v) ] + where + showFittingSize x | fromIntegral x <= (maxBound :: Word8) = + Data.Bits.Pretty.showHex8 (fromIntegral x) + showFittingSize x | fromIntegral x <= (maxBound :: Word16) = + Data.Bits.Pretty.showHex16 (fromIntegral x) + showFittingSize x | fromIntegral x <= (maxBound :: Word32) = + Data.Bits.Pretty.showHex32 (fromIntegral x) + showFittingSize x | otherwise = + Data.Bits.Pretty.showHex x