{-# 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasDimension s a => Lens' s a
dimension of
    Maybe Dimension
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
element
    Just Dimension
dim ->
      let ixs :: [String]
ixs = case Dimension
dim forall s a. s -> Getting a s a -> a
^. forall s a. HasIndex s a => Lens' s a
index of
            DimensionIndex_FromTo Int
f Int
t -> forall a b. (a -> b) -> [a] -> [b]
map 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name
                descTemplate :: String
descTemplate = a
z forall s a. s -> Getting a s a -> a
^. forall s a. HasDescription s a => Lens' s a
description
                baseOffset :: Int
baseOffset = a -> Int
getOffset a
z
                template :: String -> String -> String
template (Char
'%':Char
's':String
xs) String
replacement = String
replacement forall a. [a] -> [a] -> [a]
++ String
xs
                template (Char
x:String
xs) String
replacement = Char
xforall a. a -> [a] -> [a]
:(String -> String -> String
template String
xs String
replacement)
                template [] String
_ = forall a. Monoid a => a
mempty
            in
                Int -> a -> a
setOffset
                  (Int
baseOffset forall a. Num a => a -> a -> a
+ Dimension
dim forall s a. s -> Getting a s a -> a
^. forall s a. HasIncrement s a => Lens' s a
increment forall a. Num a => a -> a -> a
* Int
i)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set
                  forall s a. HasName s a => Lens' s a
name
                  (String -> String -> String
template String
nameTemplate String
ix)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set
                  forall s a. HasDescription s a => Lens' s a
description
                  (String -> String -> String
template String
descTemplate String
ix)
              forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set
                  forall s a. HasDimension s a => Lens' s a
dimension
                  forall a. Maybe a
Nothing
                  a
z
      in
        [ forall {a}. HasDimension a (Maybe a) => a -> Int -> String -> a
gen a
element Int
i String
ix | (Int
i, String
ix) <- 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 = forall a.
(HasName a String, HasDescription a String,
 HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (forall s a. s -> Getting a s a -> a
^. forall s a. HasBitOffset s a => Lens' s a
bitOffset) (forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. HasBitOffset s a => Lens' s a
bitOffset)

-- | Expand @Cluster@ into multiple cluster if it has a @Dimension@
-- return just the cluster if not
expandCluster :: Cluster -> [Cluster]
expandCluster :: Cluster -> [Cluster]
expandCluster = forall a.
(HasName a String, HasDescription a String,
 HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (forall s a. s -> Getting a s a -> a
^. forall s a. HasAddressOffset s a => Lens' s a
addressOffset) (forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. HasAddressOffset s a => Lens' s a
addressOffset)

-- | Expand @Register@ into multiple registers if it has a @Dimension@
-- return just the register if not
expandRegister :: Register -> [Register]
expandRegister :: Register -> [Register]
expandRegister = forall a.
(HasName a String, HasDescription a String,
 HasDimension a (Maybe Dimension)) =>
(a -> Int) -> (Int -> a -> a) -> a -> [a]
expandDim (forall s a. s -> Getting a s a -> a
^. forall s a. HasAddressOffset s a => Lens' s a
addressOffset) (forall s t a b. ASetter s t a b -> b -> s -> t
set forall s a. HasAddressOffset s a => Lens' s a
addressOffset)

-- | Expand all fields of a register
expandRegFields :: Register -> Register
expandRegFields :: Register -> Register
expandRegFields Register
r =
  forall s t a b. ASetter s t a b -> b -> s -> t
set
    forall s a. HasFields s a => Lens' s a
fields
    (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Field -> [Field]
expandField (Register
r forall s a. s -> Getting a s a -> a
^. forall s a. HasFields s a => Lens' s a
fields))
    Register
r

-- | Expand all registers of a peripheral
expandPeriphRegisters :: Peripheral -> Peripheral
expandPeriphRegisters :: Peripheral -> Peripheral
expandPeriphRegisters Peripheral
p =
  forall s t a b. ASetter s t a b -> b -> s -> t
set
    forall s a. HasRegisters s a => Lens' s a
registers
    (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Register -> [Register]
expandRegister (Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisters s a => Lens' s a
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 =
  forall s t a b. ASetter s t a b -> b -> s -> t
set
    forall s a. HasClusters s a => Lens' s a
clusters
    forall a. Monoid a => a
mempty
  forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set
      forall s a. HasRegisters s a => Lens' s a
registers
      (let
           expClusters :: [Cluster]
expClusters =
             forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
               Cluster -> [Cluster]
expandCluster
               (Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasClusters s a => Lens' s a
clusters)
        in
          (Peripheral
p forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisters s a => Lens' s a
registers)
          forall a. [a] -> [a] -> [a]
++ 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 =
  forall a b. (a -> b) -> [a] -> [b]
map
    (\Register
r ->
      forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
        forall s a. HasAddressOffset s a => Lens' s a
addressOffset
        (forall a. Num a => a -> a -> a
+(Cluster
c forall s a. s -> Getting a s a -> a
^. forall s a. HasAddressOffset s a => Lens' s a
addressOffset))
        Register
r
    )
  forall a b. (a -> b) -> a -> b
$ Cluster
c forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisters s a => Lens' s a
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 =
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
      Peripheral -> Peripheral
expandPeriphRegisters
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRegisters s a => Lens' s a
registers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
      Register -> Register
expandRegFields
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
      (forall s a. HasPeripherals s a => Lens' s a
peripherals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
      Peripheral -> Peripheral
expandPeriphClusters