{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.SVD.Dim
  ( expandDevice
  -- * For testing
  , expandCluster
  , expandField
  , expandRegister
  ) where

import Control.Lens ((^.), set, over)
import Data.SVD.Lens
import Data.SVD.Types

-- * Dimension expansion

-- Expand @Cluster@, @Field@, @Register@ into multiples
-- according to its @Dimension@
--
-- If @Dimension@ is nothing return singleton with the original
expandDim
  :: ( HasName a String
     , HasDescription a String
     , HasDimension a (Maybe Dimension)
     )
  => (a -> Int) -- ^ Address offset or bit offset getter
  -> (Int -> a -> a) -- ^ Address offset or bit offset setter
  -> 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 ]

-- | Expand @Field@ into multiple fields if it has a @Dimension@
-- return just the field if not
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)

-- | Expand @Cluster@ into multiple cluster if it has a @Dimension@
-- return just the cluster if not
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)

-- | Expand @Register@ into multiple registers if it has a @Dimension@
-- return just the register if not
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)

-- | Expand all fields of a register
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

-- | Expand all registers of a peripheral
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

-- | Expand all cluster of a peripheral
-- then eliminate all of them into registers
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

-- | Turn expanded @Cluster@ into @Register@s
-- adding its addressOffset to each registers addressOffset
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

-- | Expand all dimensions and clusters
--
-- In order
-- - Expand and eliminate each cluster
-- - Expand fields of each register
-- - Expand each register
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