{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.SVD.Dim
( expandDevice
, expandCluster
, expandField
, expandRegister
) where
import Control.Lens ((^.), set, over)
import Data.SVD.Lens
import Data.SVD.Types
expandDim
:: ( HasName a String
, HasDescription a String
, HasDimension a (Maybe Dimension)
)
=> (a -> Int)
-> (Int -> a -> a)
-> a
-> [a]
expandDim :: forall a.
(HasName a String, HasDescription a String,
HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim a -> Int
getOffset Int -> a -> a
setOffset a
element =
case a
element a
-> Getting (Maybe Dimension) a (Maybe Dimension) -> Maybe Dimension
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Dimension) a (Maybe Dimension)
forall s a. HasDimension s a => Lens' s a
Lens' a (Maybe Dimension)
dimension of
Maybe Dimension
Nothing -> a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
element
Just Dimension
dim ->
let ixs :: [String]
ixs = case Dimension
dim Dimension
-> Getting DimensionIndex Dimension DimensionIndex
-> DimensionIndex
forall s a. s -> Getting a s a -> a
^. Getting DimensionIndex Dimension DimensionIndex
forall s a. HasIndex s a => Lens' s a
Lens' Dimension DimensionIndex
index of
DimensionIndex_FromTo Int
f Int
t -> (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int
f .. Int
t]
DimensionIndex_List [String]
l -> [String]
l
gen :: a -> Int -> String -> a
gen a
z Int
i String
ix =
let nameTemplate :: String
nameTemplate = a
z a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall s a. HasName s a => Lens' s a
Lens' a String
name
descTemplate :: String
descTemplate = a
z a -> Getting String a String -> String
forall s a. s -> Getting a s a -> a
^. Getting String a String
forall s a. HasDescription s a => Lens' s a
Lens' a String
description
baseOffset :: Int
baseOffset = a -> Int
getOffset a
z
template :: String -> String -> String
template (Char
'%':Char
's':String
xs) String
replacement = String
replacement String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs
template (Char
x:String
xs) String
replacement = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:(String -> String -> String
template String
xs String
replacement)
template [] String
_ = String
forall a. Monoid a => a
mempty
in
Int -> a -> a
setOffset
(Int
baseOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Dimension
dim Dimension -> Getting Int Dimension Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Dimension Int
forall s a. HasIncrement s a => Lens' s a
Lens' Dimension Int
increment Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter a a String String -> String -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter a a String String
forall s a. HasName s a => Lens' s a
Lens' a String
name
(String -> String -> String
template String
nameTemplate String
ix)
(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter a a String String -> String -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter a a String String
forall s a. HasDescription s a => Lens' s a
Lens' a String
description
(String -> String -> String
template String
descTemplate String
ix)
(a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ ASetter a a (Maybe Dimension) (Maybe Dimension)
-> Maybe Dimension -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter a a (Maybe Dimension) (Maybe Dimension)
forall s a. HasDimension s a => Lens' s a
Lens' a (Maybe Dimension)
dimension
Maybe Dimension
forall a. Maybe a
Nothing
a
z
in
[ a -> Int -> String -> a
gen a
element Int
i String
ix | (Int
i, String
ix) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [String]
ixs ]
expandField :: Field -> [Field]
expandField :: Field -> [Field]
expandField = (Field -> Int) -> (Int -> Field -> Field) -> Field -> [Field]
forall a.
(HasName a String, HasDescription a String,
HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (Field -> Getting Int Field Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Field Int
forall s a. HasBitOffset s a => Lens' s a
Lens' Field Int
bitOffset) (ASetter Field Field Int Int -> Int -> Field -> Field
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Field Field Int Int
forall s a. HasBitOffset s a => Lens' s a
Lens' Field Int
bitOffset)
expandCluster :: Cluster -> [Cluster]
expandCluster :: Cluster -> [Cluster]
expandCluster = (Cluster -> Int)
-> (Int -> Cluster -> Cluster) -> Cluster -> [Cluster]
forall a.
(HasName a String, HasDescription a String,
HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (Cluster -> Getting Int Cluster Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Cluster Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Cluster Int
addressOffset) (ASetter Cluster Cluster Int Int -> Int -> Cluster -> Cluster
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Cluster Cluster Int Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Cluster Int
addressOffset)
expandRegister :: Register -> [Register]
expandRegister :: Register -> [Register]
expandRegister = (Register -> Int)
-> (Int -> Register -> Register) -> Register -> [Register]
forall a.
(HasName a String, HasDescription a String,
HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (Register -> Getting Int Register Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Register Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Register Int
addressOffset) (ASetter Register Register Int Int -> Int -> Register -> Register
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Register Register Int Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Register Int
addressOffset)
expandRegFields :: Register -> Register
expandRegFields :: Register -> Register
expandRegFields 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
((Field -> [Field]) -> [Field] -> [Field]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Field -> [Field]
expandField (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
expandPeriphRegisters :: Peripheral -> Peripheral
expandPeriphRegisters :: Peripheral -> Peripheral
expandPeriphRegisters Peripheral
p =
ASetter Peripheral Peripheral [Register] [Register]
-> [Register] -> Peripheral -> Peripheral
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter Peripheral Peripheral [Register] [Register]
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers
((Register -> [Register]) -> [Register] -> [Register]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Register -> [Register]
expandRegister (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))
Peripheral
p
expandPeriphClusters :: Peripheral -> Peripheral
expandPeriphClusters :: Peripheral -> Peripheral
expandPeriphClusters Peripheral
p =
ASetter Peripheral Peripheral [Cluster] [Cluster]
-> [Cluster] -> Peripheral -> Peripheral
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter Peripheral Peripheral [Cluster] [Cluster]
forall s a. HasClusters s a => Lens' s a
Lens' Peripheral [Cluster]
clusters
[Cluster]
forall a. Monoid a => a
mempty
(Peripheral -> Peripheral) -> Peripheral -> Peripheral
forall a b. (a -> b) -> a -> b
$ ASetter Peripheral Peripheral [Register] [Register]
-> [Register] -> Peripheral -> Peripheral
forall s t a b. ASetter s t a b -> b -> s -> t
set
ASetter Peripheral Peripheral [Register] [Register]
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers
(let
expClusters :: [Cluster]
expClusters =
(Cluster -> [Cluster]) -> [Cluster] -> [Cluster]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
Cluster -> [Cluster]
expandCluster
(Peripheral
p Peripheral -> Getting [Cluster] Peripheral [Cluster] -> [Cluster]
forall s a. s -> Getting a s a -> a
^. Getting [Cluster] Peripheral [Cluster]
forall s a. HasClusters s a => Lens' s a
Lens' Peripheral [Cluster]
clusters)
in
(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)
[Register] -> [Register] -> [Register]
forall a. [a] -> [a] -> [a]
++ (Cluster -> [Register]) -> [Cluster] -> [Register]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
Cluster -> [Register]
eliminateCluster
[Cluster]
expClusters
)
Peripheral
p
eliminateCluster :: Cluster -> [Register]
eliminateCluster :: Cluster -> [Register]
eliminateCluster Cluster
c =
(Register -> Register) -> [Register] -> [Register]
forall a b. (a -> b) -> [a] -> [b]
map
(\Register
r ->
ASetter Register Register Int Int
-> (Int -> Int) -> Register -> Register
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
ASetter Register Register Int Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Register Int
addressOffset
(Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Cluster
c Cluster -> Getting Int Cluster Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Cluster Int
forall s a. HasAddressOffset s a => Lens' s a
Lens' Cluster Int
addressOffset))
Register
r
)
([Register] -> [Register]) -> [Register] -> [Register]
forall a b. (a -> b) -> a -> b
$ Cluster
c Cluster -> Getting [Register] Cluster [Register] -> [Register]
forall s a. s -> Getting a s a -> a
^. Getting [Register] Cluster [Register]
forall s a. HasRegisters s a => Lens' s a
Lens' Cluster [Register]
registers
expandDevice :: Device -> Device
expandDevice :: Device -> Device
expandDevice =
ASetter Device Device Peripheral Peripheral
-> (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] -> Identity [Peripheral])
-> Device -> Identity Device)
-> ((Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device Peripheral Peripheral
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 -> Peripheral
expandPeriphRegisters
(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
. ASetter Peripheral Peripheral [Register] [Register]
forall s a. HasRegisters s a => Lens' s a
Lens' Peripheral [Register]
registers ASetter Peripheral Peripheral [Register] [Register]
-> ((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
expandRegFields
(Device -> Device) -> (Device -> Device) -> Device -> Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Device Device Peripheral Peripheral
-> (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] -> Identity [Peripheral])
-> Device -> Identity Device)
-> ((Peripheral -> Identity Peripheral)
-> [Peripheral] -> Identity [Peripheral])
-> ASetter Device Device Peripheral Peripheral
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 -> Peripheral
expandPeriphClusters