{-# LANGUAGE RecordWildCards #-}

module Data.SVD.Util
  ( addReservedFields
  , procFields
  , continuityCheck
  , checkDeviceRegisterContinuity
  , mapPeriphs
  , mapRegs
  , mapFields
  , mapDevFields
  , getPeriphByGroup
  , getPeriph
  , getPeriphMay
  , getPeriphRegMay
  , getPeriphFollow
  , getPeriphRegs
  , getPeriphReg
  , getPeriphRegAddr
  , getPeriphRegFields
  , getRegFields
  , getFieldVal
  , getFieldValues
  , anyReservedSet
  , getDevMemMap
  , registerNames
  , fieldNames
  -- * Sorting
  , sortDeviceByAddresses
  , sortDeviceByNames
  -- * Interrupts
  , fillMissingInterrupts
  ) where

import Control.Lens ((^.), over, set, view)
import Control.Monad (liftM2)
import Data.Bits (Bits, shiftR, (.&.))
import Data.SVD.Lens
import Data.SVD.Types

import qualified Data.Char
import qualified Data.Bits.Pretty
import qualified Data.Either
import qualified Data.List
import qualified Data.Maybe
import qualified Data.Set
import qualified Safe

-- | Find holes in registers and create corresponding reserved fields for these
--
-- First finds missing bits and then merges them to single reserved field
procFields :: Register -> [Field]
procFields :: Register -> [Field]
procFields Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regName :: String
regDisplayName :: String
regDimension :: Maybe Dimension
regDescription :: String
regAddressOffset :: Int
regSize :: Int
regAccess :: AccessType
regResetValue :: Maybe Int
regFields :: [Field]
regName :: Register -> String
regDisplayName :: Register -> String
regDimension :: Register -> Maybe Dimension
regDescription :: Register -> String
regAddressOffset :: Register -> Int
regSize :: Register -> Int
regAccess :: Register -> AccessType
regResetValue :: Register -> Maybe Int
regFields :: Register -> [Field]
..} =
    [Field] -> [Field]
dataIfSingleReserved
  ([Field] -> [Field]) -> [Field] -> [Field]
forall a b. (a -> b) -> a -> b
$ [Field] -> [Field]
forall a. [a] -> [a]
reverse
  ([Field] -> [Field]) -> [Field] -> [Field]
forall a b. (a -> b) -> a -> b
$ [Field] -> [Field]
sortByOffset ([Field]
regFields [Field] -> [Field] -> [Field]
forall a. [a] -> [a] -> [a]
++ [Field]
missingAsReserved)
  where
    missingAsReserved :: [Field]
missingAsReserved =
      [(Int, Int)] -> [Field]
mkReserved
      ([(Int, Int)] -> [Field]) -> [(Int, Int)] -> [Field]
forall a b. (a -> b) -> a -> b
$ [Int] -> [(Int, Int)]
forall {a}. (Eq a, Num a) => [a] -> [(a, Int)]
conts
      ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
Data.Set.toList Set Int
missing

    mkReserved :: [(Int, Int)] -> [Field]
mkReserved =
      ((Int, Int) -> Field) -> [(Int, Int)] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map
        (((Int, Int) -> Field) -> [(Int, Int)] -> [Field])
-> ((Int, Int) -> Field) -> [(Int, Int)] -> [Field]
forall a b. (a -> b) -> a -> b
$ \(Int
offset', Int
width') ->
          Field
            { fieldName :: String
fieldName = String
"_"
            , fieldDescription :: String
fieldDescription = String
"(Reserved)"
            , fieldDimension :: Maybe Dimension
fieldDimension = Maybe Dimension
forall a. Maybe a
Nothing
            , fieldBitOffset :: Int
fieldBitOffset = Int
offset'
            , fieldBitWidth :: Int
fieldBitWidth = Int
width'
            , fieldReserved :: Bool
fieldReserved = Bool
True
            , fieldRegType :: Maybe String
fieldRegType = Maybe String
forall a. Maybe a
Nothing
            }

    conts :: [a] -> [(a, Int)]
conts [a]
x = case [a] -> [a]
forall a. (Eq a, Num a) => [a] -> [a]
cont [a]
x of
      [] -> []
      [a]
s -> ([a] -> a
forall a. Partial => [a] -> a
head [a]
s, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: [a] -> [(a, Int)]
conts (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
s) [a]
x)

    -- find longest increasing sequence
    cont :: (Eq a, Num a) => [a] -> [a]
    cont :: forall a. (Eq a, Num a) => [a] -> [a]
cont (a
x:a
y:[a]
xs) | a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. (Eq a, Num a) => [a] -> [a]
cont (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
    cont (a
x:[a]
_)  = [a
x]
    cont [] = []

    missing :: Set Int
missing = Set Int
allRegs Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Data.Set.difference` Set Int
existing

    allRegs :: Set Int
allRegs = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int
0..(Int
regSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

    existing :: Set Int
existing =
      [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Data.Set.fromList
      ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ ((Field -> [Int]) -> [Field] -> [Int])
-> [Field] -> (Field -> [Int]) -> [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Field -> [Int]) -> [Field] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Field] -> [Field]
sortByOffset [Field]
regFields)
      ((Field -> [Int]) -> [Int]) -> (Field -> [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ \Field{Bool
Int
String
Maybe String
Maybe Dimension
fieldName :: Field -> String
fieldDescription :: Field -> String
fieldDimension :: Field -> Maybe Dimension
fieldBitOffset :: Field -> Int
fieldBitWidth :: Field -> Int
fieldReserved :: Field -> Bool
fieldRegType :: Field -> Maybe String
fieldName :: String
fieldDescription :: String
fieldDimension :: Maybe Dimension
fieldBitOffset :: Int
fieldBitWidth :: Int
fieldReserved :: Bool
fieldRegType :: Maybe String
..} -> [Int
fieldBitOffset .. (Int
fieldBitOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fieldBitWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]

    sortByOffset :: [Field] -> [Field]
sortByOffset = (Field -> Int) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn Field -> Int
fieldBitOffset

    -- this handles a case when there are no fields and code above
    -- creates a single full-sized reserved field
    -- which we turn into non-reserved "data" field
    dataIfSingleReserved :: [Field] -> [Field]
dataIfSingleReserved [Field
f] | Field -> Bool
fieldReserved Field
f =
      [ Field
f {
            fieldName = "DATA"
          , fieldReserved = False
          }
      ]
    dataIfSingleReserved [Field]
fs = [Field]
fs

-- | Fill in reserved fields for whole @Device@
addReservedFields :: Device -> Device
addReservedFields :: Device -> Device
addReservedFields =
  ASetter Device Device Register Register
-> (Register -> Register) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
    (([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> ((Register -> Identity Register)
    -> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device Register Register
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Peripheral -> Identity Peripheral)
 -> [Peripheral] -> Identity [Peripheral])
-> ((Register -> Identity Register)
    -> Peripheral -> Identity Peripheral)
-> (Register -> Identity Register)
-> [Peripheral]
-> Identity [Peripheral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Register] -> Identity [Register])
-> Peripheral -> Identity Peripheral
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers (([Register] -> Identity [Register])
 -> Peripheral -> Identity Peripheral)
-> ((Register -> Identity Register)
    -> [Register] -> Identity [Register])
-> (Register -> Identity Register)
-> Peripheral
-> Identity Peripheral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Register -> Identity Register)
-> [Register] -> Identity [Register]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse)
    Register -> Register
procRegister
  where
    procRegister :: Register -> Register
procRegister Register
r = ASetter Register Register [Field] [Field]
-> [Field] -> Register -> Register
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Register Register [Field] [Field]
forall s a. HasFields s a => Lens' s a
Lens' Register [Field]
fields (Register -> [Field]
procFields Register
r) Register
r

-- | Walk processed register fields top to bottom
-- checking that the register is exactly n bits long
continuityCheck :: Register -> Bool
continuityCheck :: Register -> Bool
continuityCheck Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regName :: Register -> String
regDisplayName :: Register -> String
regDimension :: Register -> Maybe Dimension
regDescription :: Register -> String
regAddressOffset :: Register -> Int
regSize :: Register -> Int
regAccess :: Register -> AccessType
regResetValue :: Register -> Maybe Int
regFields :: Register -> [Field]
regName :: String
regDisplayName :: String
regDimension :: Maybe Dimension
regDescription :: String
regAddressOffset :: Int
regSize :: Int
regAccess :: AccessType
regResetValue :: Maybe Int
regFields :: [Field]
..} = [Field] -> Int -> Bool
go [Field]
regFields Int
regSize
  where
  go :: [Field] -> Int -> Bool
go [] Int
0 = Bool
True
  go (Field
x:[Field]
xs) Int
remainingBits
    | Field -> Int
fieldBitOffset Field
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Field -> Int
fieldBitWidth Field
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
remainingBits
    = [Field] -> Int -> Bool
go [Field]
xs (Int
remainingBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Field -> Int
fieldBitWidth Field
x)
  go [Field]
_ Int
_ = Bool
False

-- | Walk processed register fields top to bottom
-- checking that the register is exactly n bits long
continuityCheckReg
  :: Device
  -> Peripheral
  -> Register
  -> Either String Register

-- Some ignores
-- TIM2.CNT, TIM5.CNT is 32 bit but has an aliased UIFCPY field
continuityCheckReg :: Device -> Peripheral -> Register -> Either String Register
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32F730", String
"STM32F745", String
"STM32F750", String
"STM32F765"
                     , String
"STM32F7x2", String
"STM32F7x3", String
"STM32F7x6", String
"STM32F7x7", String
"STM32F7x9" ]
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"TIM2", String
"TIM5" ]
  Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CNT" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
-- similar for Gs
--
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32G431xx", String
"STM32G441xx", String
"STM32G471xx", String
"STM32G473xx"
                     , String
"STM32G474xx", String
"STM32G483xx", String
"STM32G484xx", String
"STM32G491xx", String
"STM32G4A1xx" ]
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TIM2" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CNT" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
-- G4 TIM2.CCR5, might be a bug in stm32-rs
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32G431xx", String
"STM32G441xx", String
"STM32G471xx", String
"STM32G473xx"
                     , String
"STM32G474xx", String
"STM32G483xx", String
"STM32G484xx", String
"STM32G491xx", String
"STM32G4A1xx" ]
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TIM2" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CCR5" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
-- F101, F103 TIM10.CCMR1_Output aliased OC1FE field
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ String
"STM32F101", String
"STM32F103" ]
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TIM10" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CCMR1_Output" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32H73x"
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CRYP" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"K2LR" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | (Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32L0x2" Bool -> Bool -> Bool
|| Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32L0x3")
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"PWR" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CR" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TIM15" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"SR" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"SAI1" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CR1" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32L4P5"
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"FLASH" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ECCR" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r
  | Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"STM32WB55"
  Bool -> Bool -> Bool
&& Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TIM2" Bool -> Bool -> Bool
&& Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"CNT" = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
-- lots of errors in TIMx, GPDMA1
continuityCheckReg Device
d Peripheral
_p Register
r
  | String
"STM32H5" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Data.List.isPrefixOf` (Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name) = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r
continuityCheckReg Device
d Peripheral
p Register
r =
  [Field] -> Int -> Either String Register
forall {a} {s}.
(Eq a, Num a, HasBitOffset s a, HasBitWidth s a, Show a) =>
[s] -> a -> Either String Register
go
    ( [Field] -> [Field]
forall a. [a] -> [a]
reverse
    ([Field] -> [Field]) -> [Field] -> [Field]
forall a b. (a -> b) -> a -> b
$ (Field -> Int) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn
        (Getting Int Field Int -> Field -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Field Int
forall s a. HasBitOffset s a => Lens' s a
Lens' Field Int
bitOffset)
        (Register
r Register -> Getting [Field] Register [Field] -> [Field]
forall s a. s -> Getting a s a -> a
^. Getting [Field] Register [Field]
forall s a. HasFields s a => Lens' s a
Lens' Register [Field]
fields)
    )
    (Register
r Register -> Getting Int Register Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Register Int
forall s a. HasSize s a => Lens' s a
Lens' Register Int
size)
  where
  go :: [s] -> a -> Either String Register
go [] a
0 = Register -> Either String Register
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Register
r

  go (s
x:[s]
xs) a
remainingBits
    | s
x s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasBitOffset s a => Lens' s a
Lens' s a
bitOffset a -> a -> a
forall a. Num a => a -> a -> a
+ s
x s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasBitWidth s a => Lens' s a
Lens' s a
bitWidth a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
remainingBits
    = [s] -> a -> Either String Register
go [s]
xs (a
remainingBits a -> a -> a
forall a. Num a => a -> a -> a
- (s
x s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
forall s a. HasBitWidth s a => Lens' s a
Lens' s a
bitWidth))

  go [s]
_xs a
remainingBits =
    String -> Either String Register
forall a b. a -> Either a b
Left
    (String -> Either String Register)
-> String -> Either String Register
forall a b. (a -> b) -> a -> b
$ String
"Continuity check failed with remaining bits: "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
remainingBits
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for device "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Device
d Device -> Getting String Device String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Device String
forall s a. HasName s a => Lens' s a
Lens' Device String
name
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Peripheral
p Peripheral -> Getting String Peripheral String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Register
r Register -> Getting String Register String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name

-- | Check all devices registers for continuity
checkDeviceRegisterContinuity
  :: Device
  -> Either String Device
checkDeviceRegisterContinuity :: Device -> Either String Device
checkDeviceRegisterContinuity Device
d =
  let
    res :: [Either String Register]
res =
      (Peripheral -> [Either String Register])
-> [Peripheral] -> [Either String Register]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        (\Peripheral
p ->
          (Register -> Either String Register)
-> [Register] -> [Either String Register]
forall a b. (a -> b) -> [a] -> [b]
map
            (Device -> Peripheral -> Register -> Either String Register
continuityCheckReg Device
d Peripheral
p)
            (Peripheral
p Peripheral
-> Getting [Register] Peripheral [Register] -> [Register]
forall s a. s -> Getting a s a -> a
^. Getting [Register] Peripheral [Register]
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers)
        )
      (Device -> [Peripheral]
devicePeripherals Device
d)
  in
    case [Either String Register]
res of
      [Either String Register]
_ | (Either String Register -> Bool)
-> [Either String Register] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Either String Register -> Bool
forall a b. Either a b -> Bool
Data.Either.isRight [Either String Register]
res -> Device -> Either String Device
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Device
d
      [Either String Register]
_ | Bool
otherwise -> String -> Either String Device
forall a b. a -> Either a b
Left (String -> Either String Device) -> String -> Either String Device
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Either String Register] -> [String]
forall a b. [Either a b] -> [a]
Data.Either.lefts [Either String Register]
res

mapPeriphs :: (Peripheral -> b) -> Device -> [b]
mapPeriphs :: forall b. (Peripheral -> b) -> Device -> [b]
mapPeriphs Peripheral -> b
f Device{Int
String
[Peripheral]
devicePeripherals :: Device -> [Peripheral]
deviceName :: String
deviceVersion :: String
deviceDescription :: String
deviceAddressUnitBits :: Int
deviceWidth :: Int
deviceSize :: Int
deviceResetValue :: Int
deviceResetMask :: Int
devicePeripherals :: [Peripheral]
deviceName :: Device -> String
deviceVersion :: Device -> String
deviceDescription :: Device -> String
deviceAddressUnitBits :: Device -> Int
deviceWidth :: Device -> Int
deviceSize :: Device -> Int
deviceResetValue :: Device -> Int
deviceResetMask :: Device -> Int
..} = (Peripheral -> b) -> [Peripheral] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Peripheral -> b
f [Peripheral]
devicePeripherals

mapRegs :: (Register -> b) -> Peripheral -> [b]
mapRegs :: forall b. (Register -> b) -> Peripheral -> [b]
mapRegs Register -> b
f Peripheral{Int
String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
periphName :: String
periphDescription :: String
periphDerivedFrom :: Maybe String
periphGroupName :: String
periphBaseAddress :: Int
periphAddressBlock :: Maybe AddressBlock
periphInterrupts :: [Interrupt]
periphRegisters :: [Register]
periphClusters :: [Cluster]
periphName :: Peripheral -> String
periphDescription :: Peripheral -> String
periphDerivedFrom :: Peripheral -> Maybe String
periphGroupName :: Peripheral -> String
periphBaseAddress :: Peripheral -> Int
periphAddressBlock :: Peripheral -> Maybe AddressBlock
periphInterrupts :: Peripheral -> [Interrupt]
periphRegisters :: Peripheral -> [Register]
periphClusters :: Peripheral -> [Cluster]
..} = (Register -> b) -> [Register] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Register -> b
f [Register]
periphRegisters

mapFields :: (Field -> b) -> Register -> [b]
mapFields :: forall b. (Field -> b) -> Register -> [b]
mapFields Field -> b
f Register{Int
String
[Field]
Maybe Int
Maybe Dimension
AccessType
regName :: Register -> String
regDisplayName :: Register -> String
regDimension :: Register -> Maybe Dimension
regDescription :: Register -> String
regAddressOffset :: Register -> Int
regSize :: Register -> Int
regAccess :: Register -> AccessType
regResetValue :: Register -> Maybe Int
regFields :: Register -> [Field]
regName :: String
regDisplayName :: String
regDimension :: Maybe Dimension
regDescription :: String
regAddressOffset :: Int
regSize :: Int
regAccess :: AccessType
regResetValue :: Maybe Int
regFields :: [Field]
..} = (Field -> b) -> [Field] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Field -> b
f [Field]
regFields

mapDevFields :: (Field -> b) -> Device -> [b]
mapDevFields :: forall b. (Field -> b) -> Device -> [b]
mapDevFields Field -> b
f Device
d =
    [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[b]] -> [b]) -> [[b]] -> [b]
forall a b. (a -> b) -> a -> b
$ [[[b]]] -> [[b]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[[b]]] -> [[b]]) -> [[[b]]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ ((Peripheral -> [[b]]) -> Device -> [[[b]]])
-> Device -> (Peripheral -> [[b]]) -> [[[b]]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Peripheral -> [[b]]) -> Device -> [[[b]]]
forall b. (Peripheral -> b) -> Device -> [b]
mapPeriphs Device
d
  ((Peripheral -> [[b]]) -> [[[b]]])
-> (Peripheral -> [[b]]) -> [[[b]]]
forall a b. (a -> b) -> a -> b
$ (Register -> [b]) -> Peripheral -> [[b]]
forall b. (Register -> b) -> Peripheral -> [b]
mapRegs
  ((Register -> [b]) -> Peripheral -> [[b]])
-> (Register -> [b]) -> Peripheral -> [[b]]
forall a b. (a -> b) -> a -> b
$ (Field -> b) -> Register -> [b]
forall b. (Field -> b) -> Register -> [b]
mapFields Field -> b
f

-- | Get peripheral by groupName
getPeriphByGroup :: String -> Device -> Peripheral
getPeriphByGroup :: String -> Device -> Peripheral
getPeriphByGroup String
name' Device
dev =
  case String -> (Peripheral -> String) -> [Peripheral] -> [Peripheral]
forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphGroupName (Device -> [Peripheral]
devicePeripherals Device
dev) of
    [] -> String -> Peripheral
forall a. Partial => String -> a
error (String -> Peripheral) -> String -> Peripheral
forall a b. (a -> b) -> a -> b
$ String
"getPeriphByGroup, peripheral " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
    [Peripheral
p] -> Peripheral
p
    [Peripheral]
ps -> case (Peripheral -> Bool) -> [Peripheral] -> [Peripheral]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing (Maybe String -> Bool)
-> (Peripheral -> Maybe String) -> Peripheral -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> Maybe String
periphDerivedFrom) [Peripheral]
ps of
      [] -> String -> Peripheral
forall a. Partial => String -> a
error (String -> Peripheral) -> String -> Peripheral
forall a b. (a -> b) -> a -> b
$ String
"getPeriphByGroup: No non-derived peripheral found for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name'
      [Peripheral
p] -> Peripheral
p
      (Peripheral
p:[Peripheral]
_xs) -> Peripheral
p
       -- TODO: warn?
       -- error $ "getPeriphByGroup: Multiple non-derived peripheral found for " ++ name

-- | Get peripheral by name
getPeriph :: String -> Device -> Peripheral
getPeriph :: String -> Device -> Peripheral
getPeriph String
name' Device
dev =
  String -> [Peripheral] -> Peripheral
forall a. Partial => String -> [a] -> a
Safe.headNote (String
"getPeriph " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name')
  ([Peripheral] -> Peripheral)
-> ([Peripheral] -> [Peripheral]) -> [Peripheral] -> Peripheral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Peripheral -> String) -> [Peripheral] -> [Peripheral]
forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphName ([Peripheral] -> Peripheral) -> [Peripheral] -> Peripheral
forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev

-- | Get peripheral by name iff found, Nothing otherwise
getPeriphMay :: String -> Device -> Maybe Peripheral
getPeriphMay :: String -> Device -> Maybe Peripheral
getPeriphMay String
name' Device
dev =
  [Peripheral] -> Maybe Peripheral
forall a. [a] -> Maybe a
Safe.headMay
  ([Peripheral] -> Maybe Peripheral)
-> ([Peripheral] -> [Peripheral])
-> [Peripheral]
-> Maybe Peripheral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Peripheral -> String) -> [Peripheral] -> [Peripheral]
forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
name' Peripheral -> String
periphName ([Peripheral] -> Maybe Peripheral)
-> [Peripheral] -> Maybe Peripheral
forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev

-- | Get register of the peripheral by their names iff found, Nothing otherwise
getPeriphRegMay :: String -> Peripheral -> Maybe Register
getPeriphRegMay :: String -> Peripheral -> Maybe Register
getPeriphRegMay String
rName =
  [Register] -> Maybe Register
forall a. [a] -> Maybe a
Safe.headMay
  ([Register] -> Maybe Register)
-> (Peripheral -> [Register]) -> Peripheral -> Maybe Register
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Register -> String) -> [Register] -> [Register]
forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
rName Register -> String
regName ([Register] -> [Register])
-> (Peripheral -> [Register]) -> Peripheral -> [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters

-- | Filter elements matching lowercased `eqTo` after applying `by`
filterLowerBy :: String -> (a -> String) -> [a] -> [a]
filterLowerBy :: forall a. String -> (a -> String) -> [a] -> [a]
filterLowerBy String
eqTo a -> String
by =
  (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter
  ((a -> Bool) -> [a] -> [a]) -> (a -> Bool) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Data.Char.toLower String
eqTo)
    (String -> Bool) -> (a -> String) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Data.Char.toLower
    (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
by

-- | Get peripheral by name or its parent peripheral if it's
-- a derived peripheral (for example USART2 is typically derived from USART1)
getPeriphFollow :: String -> Device -> Either String Peripheral
getPeriphFollow :: String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev = case String -> Device -> Maybe Peripheral
getPeriphMay String
pName Device
dev of
  Maybe Peripheral
Nothing -> String -> Either String Peripheral
forall a b. a -> Either a b
Left (String -> Either String Peripheral)
-> String -> Either String Peripheral
forall a b. (a -> b) -> a -> b
$ String
"No peripheral found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pName
  Just Peripheral
p  -> case Peripheral -> Maybe String
periphDerivedFrom Peripheral
p of
    Maybe String
Nothing -> Peripheral -> Either String Peripheral
forall a b. b -> Either a b
Right Peripheral
p
    Just String
fromName -> case String -> Device -> Maybe Peripheral
getPeriphMay String
fromName Device
dev of
      Maybe Peripheral
Nothing -> String -> Either String Peripheral
forall a b. a -> Either a b
Left (String -> Either String Peripheral)
-> String -> Either String Peripheral
forall a b. (a -> b) -> a -> b
$ String
"Parent peripheral not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fromName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for peripheral " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pName
      Just Peripheral
parentPeriph -> Peripheral -> Either String Peripheral
forall a b. b -> Either a b
Right Peripheral
parentPeriph

-- | Get registers of the peripheral
getPeriphRegs :: String -> Device -> Either String [Register]
getPeriphRegs :: String -> Device -> Either String [Register]
getPeriphRegs String
pName Device
dev = Peripheral -> [Register]
periphRegisters (Peripheral -> [Register])
-> Either String Peripheral -> Either String [Register]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev

-- | Get specific register of the peripheral
-- Follows derived from.
getPeriphReg :: String -> String -> Device -> Either String Register
getPeriphReg :: String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev =
  (String -> Either String Register)
-> (Peripheral -> Either String Register)
-> Either String Peripheral
-> Either String Register
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> Either String Register
forall a b. a -> Either a b
Left
    (String -> Maybe Register -> Either String Register
forall a b. a -> Maybe b -> Either a b
maybeToEither String
errMsg (Maybe Register -> Either String Register)
-> (Peripheral -> Maybe Register)
-> Peripheral
-> Either String Register
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Peripheral -> Maybe Register
getPeriphRegMay String
rName)
    (Either String Peripheral -> Either String Register)
-> Either String Peripheral -> Either String Register
forall a b. (a -> b) -> a -> b
$ String -> Device -> Either String Peripheral
getPeriphFollow String
pName Device
dev
  where
    errMsg :: String
errMsg = String
"No register found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for peripheral " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pName

maybeToEither :: a -> Maybe b -> Either a b
maybeToEither :: forall a b. a -> Maybe b -> Either a b
maybeToEither a
msg Maybe b
m = case Maybe b
m of
  Just b
x -> b -> Either a b
forall a b. b -> Either a b
Right b
x
  Maybe b
Nothing -> a -> Either a b
forall a b. a -> Either a b
Left a
msg

-- | Get address of the specific register of the peripheral with `pName`
getPeriphRegAddr :: String -> String -> Device -> Either String Int
getPeriphRegAddr :: String -> String -> Device -> Either String Int
getPeriphRegAddr String
pName String
rName Device
dev =
  (\Peripheral
p Register
r -> Peripheral -> Int
periphBaseAddress Peripheral
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Register -> Int
regAddressOffset Register
r)
  (Peripheral -> Register -> Int)
-> Either String Peripheral -> Either String (Register -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Peripheral -> Either String Peripheral
forall a b. a -> Maybe b -> Either a b
maybeToEither String
errMsg (String -> Device -> Maybe Peripheral
getPeriphMay String
pName Device
dev)
  Either String (Register -> Int)
-> Either String Register -> Either String Int
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev
  where
    errMsg :: String
errMsg = String
"No peripheral found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pName

-- | Get fields of the specific register of the peripheral with `pName`
getPeriphRegFields
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> Either String [Field]
getPeriphRegFields :: String -> String -> Device -> Either String [Field]
getPeriphRegFields String
pName String
rName Device
dev =
  Register -> [Field]
regFields (Register -> [Field])
-> Either String Register -> Either String [Field]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Device -> Either String Register
getPeriphReg String
pName String
rName Device
dev

getReg
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> Register
getReg :: String -> String -> Device -> Register
getReg String
pName String
rName Device
dev =
  String -> [Register] -> Register
forall a. Partial => String -> [a] -> a
Safe.headNote String
"getReg"
  ([Register] -> Register)
-> (Peripheral -> [Register]) -> Peripheral -> Register
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Register -> Bool) -> [Register] -> [Register]
forall a. (a -> Bool) -> [a] -> [a]
filter((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
rName) (String -> Bool) -> (Register -> String) -> Register -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Register -> String
regName)
  ([Register] -> [Register])
-> (Peripheral -> [Register]) -> Peripheral -> [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters
  (Peripheral -> Register) -> Peripheral -> Register
forall a b. (a -> b) -> a -> b
$ String -> Device -> Peripheral
getPeriph String
pName Device
dev

getRegFields
  :: String -- ^ Peripheral name
  -> String -- ^ Register name
  -> Device
  -> [Field]
getRegFields :: String -> String -> Device -> [Field]
getRegFields String
pName String
rName Device
dev =
  Register -> [Field]
regFields
  (Register -> [Field]) -> Register -> [Field]
forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> Register
getReg String
pName String
rName Device
dev

-- | Get value of specific @Field@ according to input `x`
getFieldVal :: (Bits a, Num a) => a -> Field -> a
getFieldVal :: forall a. (Bits a, Num a) => a -> Field -> a
getFieldVal a
x Field
f = (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Field -> Int
fieldBitOffset Field
f) a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
2 a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ Field -> Int
fieldBitWidth Field
f a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

-- | Decode integer `x` according to Fields `fs`
getFieldValues :: (Bits a, Num a) => a -> [Field] -> [(a, Field)]
getFieldValues :: forall a. (Bits a, Num a) => a -> [Field] -> [(a, Field)]
getFieldValues a
x [Field]
fs = [a] -> [Field] -> [(a, Field)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Field -> a) -> [Field] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Field -> a
forall a. (Bits a, Num a) => a -> Field -> a
getFieldVal a
x) [Field]
fs) [Field]
fs

-- | Check if any reserved field has value other than 0
anyReservedSet :: (Eq a, Num a) => [(a, Field)] -> Bool
anyReservedSet :: forall a. (Eq a, Num a) => [(a, Field)] -> Bool
anyReservedSet = ((a, Field) -> Bool) -> [(a, Field)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(a
val, Field
f) -> a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& Field -> Bool
fieldReserved Field
f)

-- | Get memory map of the device according to its perhiperal addresses
getDevMemMap :: Device -> [(String, String)]
getDevMemMap :: Device -> [(String, String)]
getDevMemMap Device{Int
String
[Peripheral]
devicePeripherals :: Device -> [Peripheral]
deviceName :: Device -> String
deviceVersion :: Device -> String
deviceDescription :: Device -> String
deviceAddressUnitBits :: Device -> Int
deviceWidth :: Device -> Int
deviceSize :: Device -> Int
deviceResetValue :: Device -> Int
deviceResetMask :: Device -> Int
deviceName :: String
deviceVersion :: String
deviceDescription :: String
deviceAddressUnitBits :: Int
deviceWidth :: Int
deviceSize :: Int
deviceResetValue :: Int
deviceResetMask :: Int
devicePeripherals :: [Peripheral]
..} =
  (Peripheral -> (String, String))
-> [Peripheral] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map
    ((String -> String -> (String, String))
-> (Peripheral -> String)
-> (Peripheral -> String)
-> Peripheral
-> (String, String)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Int -> String
forall t. PrintfArg t => t -> String
Data.Bits.Pretty.formatHex (Int -> String) -> (Peripheral -> Int) -> Peripheral -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> Int
periphBaseAddress) Peripheral -> String
periphName)
    [Peripheral]
devicePeripherals

registerNames :: String -> Device -> [String]
registerNames :: String -> Device -> [String]
registerNames String
pName Device
dev =
  (Register -> String) -> [Register] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
    Register -> String
regName ([Register] -> [String])
-> (Peripheral -> [Register]) -> Peripheral -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peripheral -> [Register]
periphRegisters
    (Peripheral -> [String]) -> Peripheral -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Device -> Peripheral
getPeriph String
pName Device
dev

fieldNames :: String -> String -> Device -> [String]
fieldNames :: String -> String -> Device -> [String]
fieldNames String
rName String
pName Device
dev =
  (Field -> String) -> [Field] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
    Field -> String
fieldName
    ([Field] -> [String]) -> [Field] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> [Field]
getRegFields String
pName String
rName Device
dev

-- * Sorting

-- | Sort everything by memory address
sortDeviceByAddresses :: Device -> Device
sortDeviceByAddresses :: Device -> Device
sortDeviceByAddresses =
    (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> ([Peripheral] -> [Peripheral]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      ([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals
      ((Peripheral -> Int) -> [Peripheral] -> [Peripheral]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting Int Peripheral Int -> Peripheral -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Peripheral Int
forall s a. HasBaseAddress s a => Lens' s a
Lens' Peripheral Int
baseAddress))
  (Device -> Device) -> (Device -> Device) -> Device -> Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Device Device [Register] [Register]
-> ([Register] -> [Register]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> (([Register] -> Identity [Register])
    -> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device [Register] [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Peripheral -> Identity Peripheral)
 -> [Peripheral] -> Identity [Peripheral])
-> (([Register] -> Identity [Register])
    -> Peripheral -> Identity Peripheral)
-> ([Register] -> Identity [Register])
-> [Peripheral]
-> Identity [Peripheral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Register] -> Identity [Register])
-> Peripheral -> Identity Peripheral
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers)
      ((Register -> Int) -> [Register] -> [Register]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting Int Register Int -> Register -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Register Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Register Int
addressOffset))
  (Device -> Device) -> (Device -> Device) -> Device -> Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Device Device [Field] [Field]
-> ([Field] -> [Field]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> (([Field] -> Identity [Field])
    -> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device [Field] [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Peripheral -> Identity Peripheral)
 -> [Peripheral] -> Identity [Peripheral])
-> (([Field] -> Identity [Field])
    -> Peripheral -> Identity Peripheral)
-> ([Field] -> Identity [Field])
-> [Peripheral]
-> Identity [Peripheral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Register] -> Identity [Register])
-> Peripheral -> Identity Peripheral
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers (([Register] -> Identity [Register])
 -> Peripheral -> Identity Peripheral)
-> (([Field] -> Identity [Field])
    -> [Register] -> Identity [Register])
-> ([Field] -> Identity [Field])
-> Peripheral
-> Identity Peripheral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Register -> Identity Register)
-> [Register] -> Identity [Register]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Register -> Identity Register)
 -> [Register] -> Identity [Register])
-> ASetter Register Register [Field] [Field]
-> ([Field] -> Identity [Field])
-> [Register]
-> Identity [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Register Register [Field] [Field]
forall s a. HasFields s a => Lens' s a
Lens' Register [Field]
fields)
      ([Field] -> [Field]
forall a. [a] -> [a]
reverse ([Field] -> [Field]) -> ([Field] -> [Field]) -> [Field] -> [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Field -> Int) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting Int Field Int -> Field -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Field Int
forall s a. HasBitOffset s a => Lens' s a
Lens' Field Int
bitOffset))

-- | Sort everything by name
sortDeviceByNames :: Device -> Device
sortDeviceByNames :: Device -> Device
sortDeviceByNames =
    (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> ([Peripheral] -> [Peripheral]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      ([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals
      ((Peripheral -> String) -> [Peripheral] -> [Peripheral]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting String Peripheral String -> Peripheral -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Peripheral String
forall s a. HasName s a => Lens' s a
Lens' Peripheral String
name))
  (Device -> Device) -> (Device -> Device) -> Device -> Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Device Device [Register] [Register]
-> ([Register] -> [Register]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> (([Register] -> Identity [Register])
    -> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device [Register] [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Peripheral -> Identity Peripheral)
 -> [Peripheral] -> Identity [Peripheral])
-> (([Register] -> Identity [Register])
    -> Peripheral -> Identity Peripheral)
-> ([Register] -> Identity [Register])
-> [Peripheral]
-> Identity [Peripheral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Register] -> Identity [Register])
-> Peripheral -> Identity Peripheral
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers)
      ((Register -> String) -> [Register] -> [Register]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting String Register String -> Register -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Register String
forall s a. HasName s a => Lens' s a
Lens' Register String
name))
  (Device -> Device) -> (Device -> Device) -> Device -> Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Device Device [Field] [Field]
-> ([Field] -> [Field]) -> Device -> Device
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (([Peripheral] -> Identity [Peripheral])
-> Device -> Identity Device
forall s a. HasPeripherals s a => Lens' s a
Lens' Device [Peripheral]
peripherals (([Peripheral] -> Identity [Peripheral])
 -> Device -> Identity Device)
-> (([Field] -> Identity [Field])
    -> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device [Field] [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Peripheral -> Identity Peripheral)
 -> [Peripheral] -> Identity [Peripheral])
-> (([Field] -> Identity [Field])
    -> Peripheral -> Identity Peripheral)
-> ([Field] -> Identity [Field])
-> [Peripheral]
-> Identity [Peripheral]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Register] -> Identity [Register])
-> Peripheral -> Identity Peripheral
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers (([Register] -> Identity [Register])
 -> Peripheral -> Identity Peripheral)
-> (([Field] -> Identity [Field])
    -> [Register] -> Identity [Register])
-> ([Field] -> Identity [Field])
-> Peripheral
-> Identity Peripheral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Register -> Identity Register)
-> [Register] -> Identity [Register]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Register -> Identity Register)
 -> [Register] -> Identity [Register])
-> ASetter Register Register [Field] [Field]
-> ([Field] -> Identity [Field])
-> [Register]
-> Identity [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Register Register [Field] [Field]
forall s a. HasFields s a => Lens' s a
Lens' Register [Field]
fields)
      ((Field -> String) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn (Getting String Field String -> Field -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Field String
forall s a. HasName s a => Lens' s a
Lens' Field String
name))

-- * Interrupts

fillMissingInterrupts
  :: [Interrupt]
  -> [Interrupt]
fillMissingInterrupts :: [Interrupt] -> [Interrupt]
fillMissingInterrupts [Interrupt]
isrs =
  [Interrupt]
isrs
  [Interrupt] -> [Interrupt] -> [Interrupt]
forall a. [a] -> [a] -> [a]
++ ((Int -> Interrupt) -> [Int] -> [Interrupt]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Interrupt
filler ([Int] -> [Interrupt]) -> [Int] -> [Interrupt]
forall a b. (a -> b) -> a -> b
$ [Int]
missingInterrupts)
  where
    filler :: Int -> Interrupt
filler Int
x = Interrupt {
       interruptName :: String
interruptName = String
"Undefined" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
     , interruptValue :: Int
interruptValue = Int
x
     , interruptDescription :: String
interruptDescription = String
"Undefined interrupt (padding only)"
     }
    missingInterrupts :: [Int]
missingInterrupts =
      let
        vals :: [Int]
vals = (Interrupt -> Int) -> [Interrupt] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Interrupt -> Int
interruptValue [Interrupt]
isrs
      in
          Set Int -> [Int]
forall a. Set a -> [a]
Data.Set.toList
        (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference
            ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int
0 .. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
vals])
            ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
Data.Set.fromList [Int]
vals)