module Data.SVD.Diff where

import Data.Algorithm.Diff (Diff, PolyDiff(..))
import qualified Data.Algorithm.Diff
import qualified Data.List
import qualified Data.Maybe
import qualified Safe

import Data.SVD.Types
  ( Device(..)
  , Peripheral(..)
  , Register(..)
  , Field(..)
  )

import Data.SVD.Util
  ( fieldNames
  , registerNames
  )

diffPeriphNames
  :: Device
  -> Device
  -> [Diff String]
diffPeriphNames :: Device -> Device -> [Diff String]
diffPeriphNames Device
dev1 Device
dev2 =
  [String] -> [String] -> [Diff String]
forall a. Eq a => [a] -> [a] -> [Diff a]
Data.Algorithm.Diff.getDiff
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Peripheral -> String) -> [Peripheral] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Peripheral -> String
periphName ([Peripheral] -> [String]) -> [Peripheral] -> [String]
forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev1)
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Peripheral -> String) -> [Peripheral] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Peripheral -> String
periphName ([Peripheral] -> [String]) -> [Peripheral] -> [String]
forall a b. (a -> b) -> a -> b
$ Device -> [Peripheral]
devicePeripherals Device
dev2)

diffRegisterNames
  :: String
  -> Device
  -> Device
  -> [Diff String]
diffRegisterNames :: String -> Device -> Device -> [Diff String]
diffRegisterNames String
pName Device
dev1 Device
dev2 =
  [String] -> [String] -> [Diff String]
forall a. Eq a => [a] -> [a] -> [Diff a]
Data.Algorithm.Diff.getDiff
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Device -> [String]
registerNames String
pName Device
dev1)
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Device -> [String]
registerNames String
pName Device
dev2)

regNames :: Peripheral -> [String]
regNames :: Peripheral -> [String]
regNames = (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

diffRegNames :: Peripheral -> Peripheral -> [Diff String]
diffRegNames :: Peripheral -> Peripheral -> [Diff String]
diffRegNames = (Peripheral -> [String])
-> Peripheral -> Peripheral -> [Diff String]
forall a t. Ord a => (t -> [a]) -> t -> t -> [Diff a]
diff Peripheral -> [String]
regNames

regNameFields :: String -> Peripheral -> [Field]
regNameFields :: String -> Peripheral -> [Field]
regNameFields String
rName =
    Register -> [Field]
regFields
  (Register -> [Field])
-> (Peripheral -> Register) -> Peripheral -> [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Register] -> Register
forall a. Partial => String -> [a] -> a
Safe.headNote String
"regNameFields"
  ([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

diff
  :: Ord a
  => (t -> [a])
  -> t
  -> t
  -> [Diff a]
diff :: forall a t. Ord a => (t -> [a]) -> t -> t -> [Diff a]
diff t -> [a]
fn t
x t
y =
  [a] -> [a] -> [Diff a]
forall a. Eq a => [a] -> [a] -> [Diff a]
Data.Algorithm.Diff.getDiff
    ([a] -> [a]
forall a. Ord a => [a] -> [a]
Data.List.sort ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t -> [a]
fn t
x)
    ([a] -> [a]
forall a. Ord a => [a] -> [a]
Data.List.sort ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ t -> [a]
fn t
y)

diffFieldNames
  :: String
  -> String
  -> Device
  -> Device
  -> [Diff String]
diffFieldNames :: String -> String -> Device -> Device -> [Diff String]
diffFieldNames String
pName String
regName' Device
dev1 Device
dev2 =
  [String] -> [String] -> [Diff String]
forall a. Eq a => [a] -> [a] -> [Diff a]
Data.Algorithm.Diff.getDiff
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> [String]
fieldNames String
regName' String
pName Device
dev1)
    ([String] -> [String]
forall a. Ord a => [a] -> [a]
Data.List.sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> Device -> [String]
fieldNames String
regName' String
pName Device
dev2)

diffFields
  :: [Field]
  -> [Field]
  -> [PolyDiff Field Field]
diffFields :: [Field] -> [Field] -> [PolyDiff Field Field]
diffFields [Field]
as [Field]
bs =
  (Field -> Field -> Bool)
-> [Field] -> [Field] -> [PolyDiff Field Field]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
Data.Algorithm.Diff.getDiffBy
    (\Field
x Field
y ->
      (Field -> String) -> Field -> Field -> Bool
forall {a} {t}. Eq a => (t -> a) -> t -> t -> Bool
cmps Field -> String
fieldName Field
x Field
y
      Bool -> Bool -> Bool
&& (Field -> Int) -> Field -> Field -> Bool
forall {a} {t}. Eq a => (t -> a) -> t -> t -> Bool
cmps Field -> Int
fieldBitWidth Field
x Field
y
      Bool -> Bool -> Bool
&& (Field -> Int) -> Field -> Field -> Bool
forall {a} {t}. Eq a => (t -> a) -> t -> t -> Bool
cmps Field -> Int
fieldBitOffset Field
x Field
y
    )
  ((Field -> Int) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn Field -> Int
fieldBitOffset [Field]
as)
  ((Field -> Int) -> [Field] -> [Field]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Data.List.sortOn Field -> Int
fieldBitOffset [Field]
bs)
  where
    cmps :: (t -> a) -> t -> t -> Bool
cmps t -> a
fn t
a t
b = t -> a
fn t
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== t -> a
fn t
b

diffDistance :: [PolyDiff a b] -> Int
diffDistance :: forall a b. [PolyDiff a b] -> Int
diffDistance [PolyDiff a b]
x =
  [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (PolyDiff a b -> Int) -> [PolyDiff a b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PolyDiff a b -> Int
forall {a} {a} {b}. Num a => PolyDiff a b -> a
go [PolyDiff a b]
x
  where
    go :: PolyDiff a b -> a
go (Both a
_ b
_) = a
0
    go (First  a
_) = a
1
    go (Second b
_) = a
1

getBoths :: [PolyDiff a b] -> [a]
getBoths :: forall a b. [PolyDiff a b] -> [a]
getBoths = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
Data.Maybe.catMaybes ([Maybe a] -> [a])
-> ([PolyDiff a b] -> [Maybe a]) -> [PolyDiff a b] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PolyDiff a b -> Maybe a) -> [PolyDiff a b] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map PolyDiff a b -> Maybe a
forall {a} {b}. PolyDiff a b -> Maybe a
ex
  where
    ex :: PolyDiff a b -> Maybe a
ex (Both a
x b
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    ex PolyDiff a b
_ = Maybe a
forall a. Maybe a
Nothing