data-stm32 (empty) → 0.1.0.0

raw patch · 18 files changed

+812/−0 lines, 18 filesdep +ansi-wl-pprintdep +attoparsecdep +basesetup-changed

Dependencies added: ansi-wl-pprint, attoparsec, base, containers, data-stm32, hxt, hxt-xpath, pretty-simple, text, time

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +5/−0
• Setup.hs +2/−0
• app/mxmcu/Main.hs +28/−0
• app/referencepdf/Main.hs +42/−0
• app/svd/Main.hs +43/−0
• data-stm32.cabal +136/−0
• src/Data/CMX.hs +9/−0
• src/Data/CMX/Parse.hs +152/−0
• src/Data/CMX/Pretty.hs +2/−0
• src/Data/CMX/Types.hs +60/−0
• src/Data/SVD.hs +9/−0
• src/Data/SVD/Parse.hs +131/−0
• src/Data/SVD/Pretty.hs +47/−0
• src/Data/SVD/Types.hs +105/−0
• src/Lib.hs +6/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for data-cubemx++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Richard Marko <srk@48.io> (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,5 @@+# data-cubemx+++* Get SVD files from https://github.com/posborne/cmsis-svd/+* Get CubeMX files from CubeMX install dir

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,28 @@+module Main where++import System.Environment+import System.Exit++import Text.Pretty.Simple+import Data.CMX++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> putStrLn "invalid argument\nUSAGE: mxmcu [FILES]"+    fs -> parseAndShow fs++parseAndShow :: [String] -> IO()+parseAndShow [] = return ()+parseAndShow (f:fs) = do+  res <- parseMCU f+  case res of+    Left e -> do+      putStrLn ("No parse of " ++ f ++ " error was " ++ e)+      exitFailure+    Right x -> pPrint x++  parseAndShow fs++

@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Prelude hiding (readFile, putStrLn, ByteString, takeWhile, concat)+import Data.Time+import Data.Text (Text, pack, unpack, intercalate, concat)+import Data.Text.IO (readFile, putStrLn)+import Data.Time+import Data.Word++import Text.PrettyPrint.ANSI.Leijen hiding (char, string, double, (<$>))++import Data.Attoparsec.Text hiding (space)+import Data.Attoparsec.Combinator (lookAhead)+import Control.Applicative hiding (empty)+++eol = endOfLine+lskip = skipWhile (inClass " :=")+uEOL = lskip *> takeTill isEndOfLine+between open close p = do{ open; x <- p; close; return x }+quoted c = (between (char c) (char c) (takeWhile (/=c)))+squoted = quoted '\''+dquoted = quoted '"'++word = takeWhile1 (/=' ')+++parseMemoryMap = do+  "Boundary address"+  return "YEAH"++pdftextParser = parseMemoryMap++fp = "/home/rmarko/embedded/docs/f4reference.txt"++main = do+  f <- readFile fp+  case parseOnly pdftextParser f of+    Left err -> print err+    Right result -> putStrLn $ pack $ show result

@@ -0,0 +1,43 @@+module Main where++import Data.SVD+import Text.Pretty.Simple+import System.Environment+import System.Exit++import Data.List+++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> putStrLn "invalid argument\nUSAGE: svdparse [FILES]"+    fs -> parseAndShow fs++parseAndShow :: [String] -> IO()+parseAndShow [] = return ()+parseAndShow (f:fs) = do+  res <- parseSVD f+  case res of+    Left e -> do+      putStrLn ("No parse of " ++ f ++ " error was " ++ e)+      exitFailure+    Right x -> do+      --pPrint x+      putStrLn $ ppDevice x+      let+          periph = "RCC"+          reg = "CFGR"+          p = filter ((== periph) . periphName) $ devicePeripherals x+          r = filter ((== reg) . regName) $ periphRegisters $ head p++      --pPrint $ procFields $ regFields $ head r+      putStrLn $ ppRegister $ head r++      print $ maximum $ mapDevFields (length . fieldName) x+      print $ take 10 $ reverse $ sortOn fst $ mapDevFields (\x -> (length $  fieldName x, fieldName x)) x++  parseAndShow fs++

@@ -0,0 +1,136 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1291e07a76b689ead2d9b0f43f082a4f4f9c58454242714adabc5381ebcb0744++name:           data-stm32+version:        0.1.0.0+synopsis:       ARM SVD and CubeMX XML parser and pretty printer for STM32 family+description:    ARM SVD and CubeMX XML parser and pretty printer for STM32 family+category:       Parsing+homepage:       https://github.com/sorki/data-stm32#readme+bug-reports:    https://github.com/sorki/data-stm32/issues+author:         Richard Marko+maintainer:     srk@48.io+copyright:      2018 Richard Marko+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/sorki/data-stm32++library+  exposed-modules:+      Data.CMX+      Data.CMX.Parse+      Data.CMX.Pretty+      Data.CMX.Types+      Data.SVD+      Data.SVD.Parse+      Data.SVD.Pretty+      Data.SVD.Types+      Lib+  other-modules:+      Paths_data_stm32+  hs-source-dirs:+      src+  build-depends:+      ansi-wl-pprint+    , attoparsec+    , base >=4.7 && <5+    , containers+    , hxt+    , hxt-xpath+    , pretty-simple+    , text+    , time+  default-language: Haskell2010++executable mxmcu+  main-is: Main.hs+  other-modules:+      Paths_data_stm32+  hs-source-dirs:+      app/mxmcu+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      ansi-wl-pprint+    , attoparsec+    , base >=4.7 && <5+    , containers+    , data-stm32+    , hxt+    , hxt-xpath+    , pretty-simple+    , text+    , time+  default-language: Haskell2010++executable stm32-reference-pdf+  main-is: Main.hs+  other-modules:+      Paths_data_stm32+  hs-source-dirs:+      app/referencepdf+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      ansi-wl-pprint+    , attoparsec+    , base >=4.7 && <5+    , containers+    , data-stm32+    , hxt+    , hxt-xpath+    , pretty-simple+    , text+    , time+  default-language: Haskell2010++executable svdparse+  main-is: Main.hs+  other-modules:+      Paths_data_stm32+  hs-source-dirs:+      app/svd+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      ansi-wl-pprint+    , attoparsec+    , base >=4.7 && <5+    , containers+    , data-stm32+    , hxt+    , hxt-xpath+    , pretty-simple+    , text+    , time+  default-language: Haskell2010++test-suite data-cubemx-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_data_stm32+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      ansi-wl-pprint+    , attoparsec+    , base >=4.7 && <5+    , containers+    , data-stm32+    , hxt+    , hxt-xpath+    , pretty-simple+    , text+    , time+  default-language: Haskell2010

@@ -0,0 +1,9 @@+module Data.CMX (+    module Data.CMX.Types+  , module Data.CMX.Parse+  , module Data.CMX.Pretty+  ) where++import Data.CMX.Types+import Data.CMX.Parse+import Data.CMX.Pretty

@@ -0,0 +1,152 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RecordWildCards #-}+module Data.CMX.Parse where++import Control.Monad++import Control.Arrow.ArrowList+import Text.XML.HXT.Core+import qualified Data.Char as Char+import qualified Data.Set as Set+import Data.Maybe++import Data.CMX.Types++atTag tag = deep (isElem >>> hasName tag)+text = getChildren >>> getText+textAtTag tag = text <<< atTag tag+att  = getAttrValue+-- nonempty attr value+attNE x = (getAttrValue x >>> isA (/= ""))+attMaybe attname tagname = withDefault (arr Just <<< attNE attname <<< atTag tagname) Nothing++capitalized :: String -> String+capitalized (head:tail) = Char.toUpper head : map Char.toLower tail+capitalized [] = []++-- db/package.xml parser+getDBVerRel = atTag "Package" >>>+  proc x -> do+    version <- getAttrValue "DBVersion" -< x+    release <- getAttrValue "Release" <<< deep (atTag "PackDescription") -< x+    returnA -< (version, release)++-- devices/.db parser+getDB = atTag "family" >>>+  proc x -> do+    name <- getAttrValue "name" -< x+    core <- text <<< atTag "CPUcore" -< x+    header <- text <<< atTag "header" -< x++    families <- listA subFamily -< x+    returnA -< (name, core, families)++subFamily = atTag "subFamily" >>>+  proc x -> do+    name <- getAttrValue "name" -< x+    fpu <- getAttrValue "fpu" -< x+    clock <- getAttrValue "clock" -< x+    devices <- listA device -< x+    returnA -< (name, fpu, clock, devices)++device = atTag "device" >>>+  proc x -> do+    partNumbers <- text <<< atTag "PN" -< x+    variants <- text <<< atTag "variants" -< x+    memories <- listA (memory "") -< x+    memoriesITCM <- listA (memory "ITCM") -< x+    header <- text <<< atTag "header" -< x+    returnA -< (partNumbers, variants, memories, memoriesITCM, header)++memory t = atTag ("memory" ++ t) >>>+  proc x -> do+    name <- att "name" -< x+    access <- att "access" -< x+    start <- att "start" -< x+    size <- att "size" -< x+    returnA -< (name, access, start, size)++-- mcu/STM32F*.xml parser+mcu = atTag "Mcu" >>>+  proc x -> do+    mcuClockTree <- att "ClockTree" -< x+    mcuDbVersion <- att "DBVersion" -< x+    mcuFamily <- att "Family" -< x+    mcuIoType <- att "IOType" -< x+    mcuLine <- att "Line" -< x+    mcuPackage <- att "Package" -< x+    mcuRefName <- att "RefName" -< x+    mcuFrequency <- withDefault (arr (Just . read) <<< textAtTag "Frequency") Nothing -< x+    mcuDie <- textAtTag "Die" -< x+    mcuCcmRam <- withDefault (arr (Just . read) <<< textAtTag "CCMRam") Nothing -< x+    mcuCore <- textAtTag "Core" -< x++    hasPowerPad' <- att "HasPowerPad" -< x+    ramVariants' <- listA (textAtTag "Ram") -< x+    flashVariants' <- listA (textAtTag "Flash") -< x+    numberOfIO' <- textAtTag "IONb" -< x++    voltageMin <- attMaybe "Min" "Voltage" -< x+    voltageMax <- attMaybe "Max" "Voltage" -< x++    temperatureMin <- attMaybe "Min" "Temperature" -< x+    temperatureMax <- attMaybe "Max" "Temperature" -< x++    currentLowest <- attMaybe "Lowest" "Current"-< x+    currentRun <- attMaybe "Run" "Current" -< x++    ips' <- listA ip -< x+    pins' <- listA pin -< x++    let+      mcuIps = Set.fromList ips'+      mcuPins = Set.fromList pins'+      mcuRamVariants = map read ramVariants'+      mcuFlashVariants = map read flashVariants'+      mcuHasPowerPad = read $ capitalized hasPowerPad'+      mcuNumberOfIO = read numberOfIO'+      mcuLimits = catMaybes [+          maybe Nothing (Just . Limit Min Voltage . read) voltageMin+        , maybe Nothing (Just . Limit Max Voltage . read) voltageMax++        , maybe Nothing (Just . Limit Min Temperature . read) temperatureMin+        , maybe Nothing (Just . Limit Max Temperature . read) temperatureMax++        , maybe Nothing (Just . Limit Lowest Current . read) currentLowest+        , maybe Nothing (Just . Limit Run Current . read) currentRun+        ]++    returnA -< MCU{..}++ip = atTag "IP" >>>+  proc x -> do+    ipName <- att "Name" -< x+    ipVersion <- att "Version" -< x+    ipConfigFile <- att "ConfigFile" -< x+    ipClockEnableMode <- att "clockEnableMode" -< x+    ipInstanceName <- att "InstanceName" -< x+    returnA -< IP{..}+++pin = atTag "Pin" >>>+  proc x -> do+    pinName <- att "Name" -< x+    pinPosition <- att "Position" -< x+    pinType <- att "Type" -< x+    pinSignals <- listA signal -< x++    returnA -< Pin{..}++signal = atTag "Signal" >>>+  proc x -> do+    sigName <- att "Name" -< x+    sigIOModes <- att "IOModes" -< x+    returnA -< Signal{..}++parseMCU f = do+  res <- runX (readDocument [] f >>> mcu)+  case res of+    [] -> return $ Left "no mcu parsed"+    [x] -> return $ Right x+    _ -> return $ Left "multiple mcus parsed" 

@@ -0,0 +1,2 @@+module Data.CMX.Pretty where+

@@ -0,0 +1,60 @@+module Data.CMX.Types where++import qualified Data.Set as Set++type Kb = Int+type Mhz = Int++data MCU = MCU {+    mcuCore :: String+  , mcuFamily :: String+  , mcuHasPowerPad :: Bool+  , mcuIoType :: String+  , mcuDie :: String+  , mcuLine :: String+  , mcuPackage :: String+  , mcuRefName :: String+  , mcuFrequency :: Maybe Mhz+  , mcuNumberOfIO :: Int+  , mcuDbVersion :: String+  , mcuRamVariants :: [Kb]+  , mcuFlashVariants :: [Kb]+  , mcuCcmRam :: Maybe Kb+  , mcuLimits :: [Limit]+  , mcuIps :: Set.Set IP+  , mcuPins :: Set.Set Pin+  } deriving (Eq, Ord, Show)++data LimitType = Min | Max | Lowest | Run+  deriving (Eq, Ord, Show)++data LimitUnit = Voltage | Current | Temperature+  deriving (Eq, Ord, Show)++data Limit = Limit {+    limitType :: LimitType+  , limitUnit :: LimitUnit+  , limitVal  :: Float+  }+  deriving (Eq, Ord, Show)++data IP = IP {+    ipName :: String+  , ipVersion :: String+  , ipConfigFile :: String+  , ipClockEnableMode :: String+  , ipInstanceName :: String+  } deriving (Eq, Ord, Show)++data Pin = Pin {+    pinName :: String+  , pinType :: String+  , pinPosition :: String+  , pinSignals :: [Signal]+  } deriving (Eq, Ord, Show)++data Signal = Signal {+    sigName :: String+  , sigIOModes :: String+  } deriving (Eq, Ord, Show)+

@@ -0,0 +1,9 @@+module Data.SVD (+    module Data.SVD.Types+  , module Data.SVD.Parse+  , module Data.SVD.Pretty+  ) where++import Data.SVD.Types+import Data.SVD.Parse+import Data.SVD.Pretty

@@ -0,0 +1,131 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RecordWildCards #-}++module Data.SVD.Parse where++import Control.Monad++import Control.Arrow.ArrowList+import Text.XML.HXT.Core+import qualified Data.Char as Char++import Data.SVD.Types++-- atTag doesn't uses deep here+atTag tag = getChildren >>> hasName tag+text = getChildren >>> getText+textAtTag tag = text <<< atTag tag+att  = getAttrValue+-- nonempty attr value+attNE x = (getAttrValue x >>> isA (/= ""))+attMaybe attname tagname = withDefault (arr Just <<< attNE attname <<< atTag tagname) Nothing+++filterCrap = unwords . words . filter ( not . (flip elem ['\n', '\t', '\r']))++-- svd parser+svd = atTag "device" >>>+  proc x -> do+    --name <- text <<< hasName "name" <<< getChildren -< x+    deviceName <- textAtTag "name" -< x+    deviceVersion <- textAtTag "version" -< x+    desc <- textAtTag "description" -< x+    addressUnitBits' <- textAtTag "addressUnitBits" -< x+    width' <- textAtTag "width" -< x+    size' <- textAtTag "size" -< x+    resetValue' <- textAtTag "resetValue" -< x+    resetMask' <- textAtTag "resetMask" -< x++    let deviceAddressUnitBits = read addressUnitBits'+        deviceWidth = read width'+        deviceSize = read size'+        deviceResetValue = read resetValue'+        deviceResetMask = read resetMask'+        deviceDescription = filterCrap desc++    devicePeripherals <- listA peripheral <<< atTag "peripherals" -< x++    returnA -< Device{..}++peripheral = atTag "peripheral" >>>+  proc x -> do+    periphName <- textAtTag "name" -< x+    periphDerivedFrom <- withDefault (arr Just <<< isA (/= "") <<< att "derivedFrom") Nothing -< x+    desc <- withDefault (textAtTag "description") "" -< x+    periphGroupName <- withDefault (textAtTag "groupName") "" -< x+    baseAddress' <- textAtTag "baseAddress" -< x+    periphAddressBlock <- withDefault (arr Just <<< addressBlock) Nothing -< x++    periphInterrupts <- listA interrupt -< x++    periphRegisters <- listA register -< x++    let periphBaseAddress = read baseAddress'+        periphDescription = filterCrap desc++    returnA -< Peripheral{..}++addressBlock = atTag "addressBlock" >>>+  proc x -> do+    offset <- textAtTag "offset" -< x+    size <- textAtTag "size" -< x+    addressBlockUsage <- textAtTag "usage" -< x++    let addressBlockOffset = read offset+        addressBlockSize = read size++    returnA -< AddressBlock{..}++interrupt = atTag "interrupt" >>>+  proc x -> do+    interruptName <- textAtTag "name" -< x+    desc <- textAtTag "description" -< x+    val <- textAtTag "value" -< x++    let interruptValue = read val+        interruptDescription = filterCrap desc++    returnA -< Interrupt{..}++register = atTag "registers" >>> atTag "register" >>>+  proc x -> do+    regName <- textAtTag "name" -< x+    regDisplayName <- textAtTag "displayName" -< x+    desc <- textAtTag "description" -< x++    offset <- textAtTag "addressOffset" -< x+    size <- textAtTag "size" -< x+    access <- withDefault (textAtTag "access") "read-write" -< x+    resetValue <- textAtTag "resetValue" -< x++    regFields <- listA field <<< atTag "fields" -< x++    let regAddressOffset = read offset+        regSize = read size+        regAccess = toAccessType access+        regResetValue = read resetValue+        regDescription = filterCrap desc++    returnA -< Register{..}++field = atTag "field" >>>+  proc x -> do+    fieldName <- textAtTag "name" -< x+    desc <- textAtTag "description" -< x+    bitOffset <- textAtTag "bitOffset" -< x+    bitWidth <- textAtTag "bitWidth" -< x++    let fieldBitOffset = read bitOffset+        fieldBitWidth = read bitWidth+        fieldDescription = filterCrap desc+        fieldReserved = False++    returnA -< Field{..}++parseSVD f = do+  res <- runX (readDocument [] f >>> svd)+  case res of+    [] -> return $ Left "no device parsed"+    [x] -> return $ Right x+    _ -> return $ Left $ "multiple devices parsed"

@@ -0,0 +1,47 @@+{-# LANGUAGE RecordWildCards #-}++module Data.SVD.Pretty where++import Data.SVD.Types+import Text.PrettyPrint.ANSI.Leijen+import Text.Printf++ppList pp x = vcat $ map pp x++ppDevice res = displayS (renderPretty 0.4 80 (ppDevice' res)) ""+ppPeripheral res = displayS (renderPretty 0.4 80 (ppPeriph res)) ""+ppRegister res = displayS (renderPretty 0.4 80 (ppReg res)) ""++ppDevice' Device{..} =+  (red $ string deviceName)+  <$$> indent 2 (ppList ppPeriph devicePeripherals)++ppPeriph Peripheral{..} =+  hardline+  <> (yellow $ string periphName)+  <+> (white $ ppHex periphBaseAddress)+  <+> (magenta $ string periphDescription)+  <$$> indent 2 (ppList ppReg periphRegisters)+  <//> (maybe empty (\x -> string "Derived from" <+> string x) periphDerivedFrom)++ppReg Register{..} =+  hardline+  <> (blue $ string regName)+  <+> (white $ ppHex regAddressOffset)+  <+> (cyan $ char '-' <+> (string regDescription))+  <$$> indent 2 (ppList ppField (procFields regFields))++ppHex = text . printf "0x%x"+rpad m xs = take m $ xs ++ repeat ' '++ppField Field{..} =+  (green $ string $ rpad 10 fieldName)+  <+> ppWidthPad 7 fieldBitWidth+  <+> parens (string fieldDescription)++ppWidth 1 = string "Bit"+ppWidth x = string "Bits" <+> int x++ppWidthPad m 1 = string $ rpad m "Bit"+ppWidthPad m x = string $ rpad m $ "Bits " ++ show x+

@@ -0,0 +1,105 @@+{-# LANGUAGE RecordWildCards #-}+module Data.SVD.Types where++import Data.List+import qualified Data.Set as Set+++data Device = Device {+    deviceName            :: String+  , deviceVersion         :: String+  , deviceDescription     :: String+  , deviceAddressUnitBits :: Int+  , deviceWidth           :: Int+  , deviceSize            :: Int+  , deviceResetValue      :: Int+  , deviceResetMask       :: Int+  , devicePeripherals     :: [Peripheral]+  } deriving (Eq, Ord, Show)++data Peripheral = Peripheral {+    periphName         :: String+  , periphDescription  :: String+  , periphDerivedFrom  :: Maybe String+  , periphGroupName    :: String+  , periphBaseAddress  :: Int+  , periphAddressBlock :: Maybe AddressBlock+  , periphInterrupts   :: [Interrupt]+  , periphRegisters    :: [Register]+  } deriving (Eq, Ord, Show)++data AddressBlock = AddressBlock {+    addressBlockOffset :: Int+  , addressBlockSize   :: Int+  , addressBlockUsage  :: String+  } deriving (Eq, Ord, Show)++data Interrupt = Interrupt {+    interruptName        :: String+  , interruptDescription :: String+  , interruptValue       :: Int+  } deriving (Eq, Ord, Show)++data Register = Register {+    regName          :: String+  , regDisplayName   :: String+  , regDescription   :: String+  , regAddressOffset :: Int+  , regSize          :: Int+  , regAccess        :: AccessType+  , regResetValue    :: Int+  , regFields        :: [Field]+  } deriving (Eq, Ord, Show)++data AccessType = ReadOnly | WriteOnly | ReadWrite | WriteOnce | ReadWriteOnce+  deriving (Eq, Ord, Show)++data Field = Field {+    fieldName        :: String+  , fieldDescription :: String+  , fieldBitOffset   :: Int+  , fieldBitWidth    :: Int+  , fieldReserved    :: Bool  -- so we can add reserved fields to the list+  } deriving (Eq, Ord, Show)++toAccessType "read-only" = ReadOnly+toAccessType "write-only" = WriteOnly+toAccessType "read-write" = ReadWrite+toAccessType "writeOnce" = WriteOnce+toAccessType "read-writeOnce" = ReadWriteOnce+toAccessType x = error $ "Unable to read AccessType" ++ x++-- find holes in registers and create corresponding reserved fields for these+-- this first finds missing missing bits and them merges them to single reserved field+procFields f = reverse $ sortByOffset (f ++ missingAsReserved)+  where+    missingAsReserved = reserved $ conts $ Set.toList missing++    reserved = map (\(offset, width) -> Field "_" "Reserved" offset width True)++    conts x = case cont x of+      [] -> []+      s -> [(head s, length s)] ++ conts (drop (length s) x)++    missing = all `Set.difference` existing++    all = Set.fromList [0..31]++    existing = Set.fromList $ flip concatMap (sortByOffset f) $+      \Field{..} -> [fieldBitOffset .. (fieldBitOffset + fieldBitWidth - 1)]++    sortByOffset = sortOn fieldBitOffset++-- find longest increasing sequence+cont (x:y:xs) | (x + 1 == y) = [x] ++ cont (y:xs)+cont (x:xs)  = [x]+cont [] = []+++mapPeriphs f Device{..} = map f devicePeripherals+mapRegs f Peripheral{..} = map f periphRegisters+mapFields f Register{..} = map f regFields++mapDevFields f d = concat $ concat $ flip mapPeriphs d $ mapRegs $ mapFields f++

@@ -0,0 +1,6 @@+module Lib+    ( someFunc+    ) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"