data-svd 0.1.0.0 → 0.1.1.0

raw patch · 8 files changed

+385/−87 lines, 8 filesdep +boxesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: boxes

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• data-svd.cabal +4/−1
• src/Data/Bits/Pretty.hs +1/−1
• src/Data/SVD/Parse.hs +9/−23
• src/Data/SVD/Pretty.hs +0/−52
• src/Data/SVD/Pretty/Box.hs +181/−0
• src/Data/SVD/Pretty/Explore.hs +186/−0
• src/Data/SVD/Util.hs +0/−10

@@ -1,3 +1,7 @@+# Version [0.1.1.0](https://github.com/DistRap/data-svd/compare/0.1.0.0...0.1.1.0) (2023-12-25)++* Added `Data.SVD.Pretty.Explore` with `exploreRegister`+ # Version [0.1.0.0](https://github.com/DistRap/data-svd/compare/de41e81...0.1.0.0) (2023-12-24)  * Initial release

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                data-svd-version:             0.1.0.0+version:             0.1.1.0 synopsis:            SVD (System view description) file handling description:         Parse, print, diff SVD files homepage:            https://github.com/DistRap/data-svd@@ -34,9 +34,12 @@                        Data.SVD.Lens                        Data.SVD.Parse                        Data.SVD.Pretty+                       Data.SVD.Pretty.Box+                       Data.SVD.Pretty.Explore                        Data.SVD.Types                        Data.SVD.Util   build-depends:       base >= 4.7 && < 5+                     , boxes                      , bytestring                      , containers                      , cereal

@@ -33,7 +33,7 @@     )     x --- | Format number using decimal+-- | Format number using decimal notation showDec :: (PrintfArg t, FiniteBits t) => t -> String showDec x =   printf ("%0" ++ (show decSize) ++ "u") x

@@ -2,9 +2,10 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RecordWildCards #-} -module Data.SVD.Parse where--import Safe+module Data.SVD.Parse+  ( svd+  )+  where  import Control.Arrow.ArrowList import qualified Data.Char as Char@@ -14,6 +15,8 @@  import Data.SVD.Types +import qualified Safe+ -- atTag doesn't uses deep here atTag :: ArrowXml cat => String -> cat (NTree XNode) XmlTree atTag tag = getChildren >>> hasName tag@@ -30,16 +33,6 @@ att :: ArrowXml cat => String -> cat XmlTree String att  = getAttrValue --- nonempty attr value-attNE :: ArrowXml cat => String -> cat XmlTree String-attNE x = getAttrValue x >>> isA (/= "")--attMaybe :: ArrowXml cat => String -> String -> cat (NTree XNode) (Maybe String)-attMaybe attname tagname =-  withDefault-    (arr Just <<< attNE attname <<< atTag tagname)-    Nothing- filterCrap :: String -> String filterCrap =   unwords@@ -47,7 +40,7 @@   . filter (\c -> Char.ord c < 127)   . filter ( not . (`elem` ['\n', '\t', '\r'])) --- svd parser+-- | SVD XML parser svd :: ArrowXml cat => cat (NTree XNode) Device svd = atTag "device" >>>   proc x -> do@@ -72,13 +65,6 @@      returnA -< Device{..} --- loose version of svd that doesn't require device properties-svdPeripherals :: ArrowXml cat => cat (NTree XNode) [Peripheral]-svdPeripherals = atTag "device" >>>-  proc x -> do-    devicePeripherals <- listA parsePeripheral <<< atTag "peripherals" -< x-    returnA -< devicePeripherals- parsePeripheral :: ArrowXml cat => cat (NTree XNode) Peripheral parsePeripheral = atTag "peripheral" >>>   proc x -> do@@ -220,7 +206,7 @@     returnA -< Field{..}     where       splitRange :: String -> (Int, Int)-      splitRange r = (readNote "splitRange" $ takeWhile (/=':') raw,-                      readNote "splitRange" $ drop 1 $ dropWhile (/=':') raw)+      splitRange r = (Safe.readNote "splitRange" $ takeWhile (/=':') raw,+                      Safe.readNote "splitRange" $ drop 1 $ dropWhile (/=':') raw)         where           raw = drop 1 $ init r

@@ -30,24 +30,16 @@   , shortField   -- ** MemMap   , ppMem-  -- * Who knows-  , printSetFields-  , printSetField-  , showField-  , fieldRange-  , hexFieldVal   )   where  import Data.Char (toLower) import Data.SVD.Types-import Data.Word import Prettyprinter import Prettyprinter.Render.String import Prettyprinter.Render.Terminal (AnsiStyle, Color(..), color)  import qualified Data.Bits.Pretty-import qualified Data.SVD.Util import qualified Data.Text import qualified Prettyprinter.Render.Terminal @@ -212,48 +204,4 @@   where     name = pretty (map toLower periph) <> "_periph_base" --- | Print currently set (non-zero) fields-printSetFields :: (Show a, Eq a, Num a) => [(a, Field)] -> String-printSetFields =-    unlines-  . map printSetField-  . Data.SVD.Util.filterSet -printSetField :: (Show a, Eq a, Num a) => (a, Field) -> String-printSetField (_, f) | fieldBitWidth f == 1 = concat ["Bit ", show (fieldBitOffset f), " ", fieldName f]-printSetField (v, f) | otherwise = concat [-    "Bits ["-  , show (fieldBitOffset f)-  , ":"-  , show (fieldBitOffset f + fieldBitWidth f - 1)-  , "]"-  , " "-  , fieldName f-  , " value ", show v]---- | Show `Field` with its range, e.g BRR[15:0] (16 bit wide)-showField :: Field -> String-showField f@Field{..} | fieldReserved = "◦" ++ (fieldRange f)-showField f@Field{..} | otherwise = fieldName ++ (fieldRange f)---- | Datasheeeet like-fieldRange :: Field -> String-fieldRange Field{..} | fieldBitWidth == 1 = ""-fieldRange Field{..} | otherwise = concat ["[", show $ fieldBitWidth - 1, ":0]"]---- | Format field value in hex, padded according to `fieldBitWidth`-hexFieldVal :: (Integral x, Show x) => Field -> x -> String-hexFieldVal _ 0 = "0"-hexFieldVal f x | fieldBitWidth f ==  1 = showBit x-  where-    showBit 0 = "0"-    showBit 1 = "1"-    showBit y = error $ "Not a bit: " ++ show y-hexFieldVal f x | fieldBitWidth f <=  8 =-  Data.Bits.Pretty.showHex (fromIntegral x :: Word8)-hexFieldVal f x | fieldBitWidth f <= 16 =-  Data.Bits.Pretty.showHex (fromIntegral x :: Word16)-hexFieldVal f x | fieldBitWidth f <= 32 =-  Data.Bits.Pretty.showHex (fromIntegral x :: Word32)-hexFieldVal _ x | otherwise =-  Data.Bits.Pretty.showHex (fromIntegral x :: Word64)

@@ -0,0 +1,181 @@+{-# LANGUAGE RecordWildCards #-}++module Data.SVD.Pretty.Box+  ( renderFields+  ) where++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+renderFields+  :: ( Bits a+     , Num a+     , Show a+     , Integral a)+  => [(a, Field)]+  -> String+renderFields fs | headerSize >= 80 = do+     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+      $ map+          (length . showField . snd)+          fs++renderFields fs | otherwise =+    Text.PrettyPrint.Boxes.render+  . table+  . remap+  $ fs++table :: [[String]] -> Box+table rows =+  hSepDeco+  Text.PrettyPrint.Boxes.<>+     Text.PrettyPrint.Boxes.punctuateH+       Text.PrettyPrint.Boxes.top+       hSepDeco+       (map fmtColumn cols)+  Text.PrettyPrint.Boxes.<> hSepDeco+    where+      cols = Data.List.transpose rows+      nrows = length rows+      hSepDeco =+       Text.PrettyPrint.Boxes.vcat+         Text.PrettyPrint.Boxes.left+         $ map+             Text.PrettyPrint.Boxes.char+             (+               "+"+               <>+               (concat $ replicate nrows "|+")+             )++fmtColumn :: [String] -> Box+fmtColumn items =+     vSepDeco+  // Text.PrettyPrint.Boxes.punctuateV+       Text.PrettyPrint.Boxes.center2+       vSepDeco+       (map+          Text.PrettyPrint.Boxes.text+          items+        )+  // vSepDeco+  where width' = maximum $ map length items+        vSepDeco =+          Text.PrettyPrint.Boxes.text+          $ replicate width' '-'++remap+  :: ( Integral x+     , Show x+     )+  => [(x, Field)]+  -> [[String]]+remap fs =+  [ map+      (showField . snd)+      fs+  , map+      (\(v, f) -> hexFieldVal f v)+      fs+  ]++takeBits+  :: Int+  -> [(a, Field)]+  -> [(a, Field)]+takeBits 0 _ = []+takeBits x (y@(_, f):fs) | x >= fieldBitWidth f = y : (takeBits (x - fieldBitWidth f) fs)+takeBits x (y@(_, f):_fs) | x <  fieldBitWidth f = [splitField x y]+  where+    splitField x' (v, f') =+      ( v+      , f+          { fieldBitWidth = x'+          , fieldBitOffset = fieldBitOffset f' + (fieldBitWidth f' - x')+          }+      )+takeBits _ _ = []++dropBits+  :: Int+  -> [(a, Field)]+  -> [(a, Field)]+dropBits 0 fs = fs+dropBits x ((_, f):fs) | x >= fieldBitWidth f = dropBits (x - fieldBitWidth f) fs+dropBits x (y@(_, f):fs) | x <  fieldBitWidth f = (splitField x y):fs+  where+    splitField x' (v, f') =+      ( v+      , f { fieldBitWidth = fieldBitWidth f' - x' }+      )+dropBits _ _ = []++-- | Show `Field` with its range, e.g BRR[15:0] (16 bit wide)+showField :: Field -> String+showField f@Field{..} | fieldReserved =+     "◦"+  <> fieldRange f+showField f@Field{..} | otherwise =+     fieldName+  <> fieldRange f++-- | Datasheeeet like+fieldRange :: Field -> String+fieldRange Field{..} | fieldBitWidth == 1 = ""+fieldRange Field{..} | otherwise =+  concat+    [ "["+    , show $ fieldBitWidth - 1+    , ":0]"+    ]++-- | Format field value in hex, padded according to `fieldBitWidth`+hexFieldVal :: (Integral x, Show x) => Field -> x -> String+hexFieldVal _ 0 = "0"+hexFieldVal f x | fieldBitWidth f ==  1 = showBit x+  where+    showBit 0 = "0"+    showBit 1 = "1"+    showBit y = error $ "Not a bit: " ++ show y+hexFieldVal f x | fieldBitWidth f <=  8 =+  Data.Bits.Pretty.showHex (fromIntegral x :: Word8)+hexFieldVal f x | fieldBitWidth f <= 16 =+  Data.Bits.Pretty.showHex (fromIntegral x :: Word16)+hexFieldVal f x | fieldBitWidth f <= 32 =+  Data.Bits.Pretty.showHex (fromIntegral x :: Word32)+hexFieldVal _ x | otherwise =+  Data.Bits.Pretty.showHex (fromIntegral x :: Word64)

@@ -0,0 +1,186 @@+{-# 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 x addr reg =+    putStrLn+  $ Data.SVD.Pretty.displayPretty+  $ exploreRegister' x addr 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+prettySetFields+  :: ( Show a+     , Eq a+     , Num a+     , FiniteBits a+     , PrintfArg a+     , Integral a+     )+  => [(a, Field)]+  -> Doc AnsiStyle+prettySetFields =+    vsep+  . map prettySetField+  . filterSet+  where+    -- | Filter fields with non zero value+    filterSet+      :: ( Eq a+         , Num a+         )+      => [(a, Field)]+      -> [(a, Field)]+    filterSet = filter ((/= 0) . fst)++prettySetField+  :: ( Show a+     , Eq a+     , Num a+     , FiniteBits a+     , PrintfArg a+     , Integral a+     )+  => (a, Field)+  -> Doc AnsiStyle+prettySetField (_, f) | fieldBitWidth f == 1 =+  hcat+    [ "Bit "+    , pretty (fieldBitOffset f)+    , " "+    , annotate+        (color Cyan)+        (pretty $ fieldName f)+    ]+prettySetField (v, f) | otherwise =+  hcat+    [ "Bits ["+    , pretty (fieldBitOffset f)+    , ":"+    , pretty (fieldBitOffset f + fieldBitWidth f - 1)+    , "]"+    , " "+    , 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

@@ -21,9 +21,7 @@   , getRegFields   , getFieldVal   , getFieldValues-  , getProcdFieldValues   , anyReservedSet-  , filterSet   , getDevMemMap   , registerNames   , fieldNames@@ -342,17 +340,9 @@ getFieldValues :: (Bits a, Num a) => a -> [Field] -> [(a, Field)] getFieldValues x fs = zip (map (getFieldVal x) fs) fs --- | Same as `getFieldValues` but with processed fields (reserved fields included)-getProcdFieldValues :: (Bits a, Num a) => a -> Register -> [(a, Field)]-getProcdFieldValues x fs = getFieldValues x $ procFields fs- -- | Check if any reserved field has value other than 0 anyReservedSet :: (Eq a, Num a) => [(a, Field)] -> Bool anyReservedSet = any (\(val, f) -> val /= 0 && fieldReserved f)---- | Filter fields with non zero value-filterSet :: (Eq a, Num a) => [(a, Field)] -> [(a, Field)]-filterSet = filter ((/= 0) . fst)  -- | Get memory map of the device according to its perhiperal addresses getDevMemMap :: Device -> [(String, String)]