{-# LANGUAGE Arrows #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE RecordWildCards #-}

module Data.SVD.Parse where

import Safe

import Control.Arrow.ArrowList
import qualified Data.Char as Char
import qualified Data.Maybe
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.Core

import Data.SVD.Types

-- atTag doesn't uses deep here
atTag :: ArrowXml cat => String -> cat (NTree XNode) XmlTree
atTag :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
tag = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
hasName String
tag

text :: ArrowXml cat => cat (NTree XNode) String
text :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) String
text = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) String
getText

textAtTag :: ArrowXml cat => String -> cat (NTree XNode) String
textAtTag :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
tag = forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) String
text forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
tag

textAtTagOrEmpty :: ArrowXml cat => String -> cat (NTree XNode) String
textAtTagOrEmpty :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTagOrEmpty String
tag = forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) String
text forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
tag) String
""

att :: ArrowXml cat => String -> cat XmlTree String
att :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
att  = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
getAttrValue

-- nonempty attr value
attNE :: ArrowXml cat => String -> cat XmlTree String
attNE :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
attNE String
x = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
getAttrValue String
x forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall a. Eq a => a -> a -> Bool
/= String
"")

attMaybe :: ArrowXml cat => String -> String -> cat (NTree XNode) (Maybe String)
attMaybe :: forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> String -> cat (NTree XNode) (Maybe String)
attMaybe String
attname String
tagname =
  forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault
    (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
attNE String
attname forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
tagname)
    forall a. Maybe a
Nothing

filterCrap :: String -> String
filterCrap :: String -> String
filterCrap =
  [String] -> String
unwords
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char -> Int
Char.ord Char
c forall a. Ord a => a -> a -> Bool
< Int
127)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\n', Char
'\t', Char
'\r']))

-- svd parser
svd :: ArrowXml cat => cat (NTree XNode) Device
svd :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Device
svd = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"device" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    --name <- text <<< hasName "name" <<< getChildren -< x
    String
deviceName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    String
deviceVersion <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"version" -< NTree XNode
x
    String
desc <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"description" -< NTree XNode
x
    String
addressUnitBits' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"addressUnitBits" -< NTree XNode
x
    String
width' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"width" -< NTree XNode
x
    String
size' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"size" -< NTree XNode
x
    String
resetValue' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"resetValue" -< NTree XNode
x
    String
resetMask' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"resetMask" -< NTree XNode
x

    let deviceAddressUnitBits :: a
deviceAddressUnitBits = forall a. Read a => String -> a
read String
addressUnitBits'
        deviceWidth :: a
deviceWidth = forall a. Read a => String -> a
read String
width'
        deviceSize :: a
deviceSize = forall a. Read a => String -> a
read String
size'
        deviceResetValue :: a
deviceResetValue = forall a. Read a => String -> a
read String
resetValue'
        deviceResetMask :: a
deviceResetMask = forall a. Read a => String -> a
read String
resetMask'
        deviceDescription :: String
deviceDescription = String -> String
filterCrap String
desc

    [Peripheral]
devicePeripherals <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Peripheral
parsePeripheral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"peripherals" -< NTree XNode
x

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Device{String
[Peripheral]
forall {a}. Read a => a
devicePeripherals :: [Peripheral]
deviceResetMask :: Int
deviceResetValue :: Int
deviceSize :: Int
deviceWidth :: Int
deviceAddressUnitBits :: Int
deviceDescription :: String
deviceVersion :: String
deviceName :: String
devicePeripherals :: [Peripheral]
deviceDescription :: String
deviceResetMask :: forall {a}. Read a => a
deviceResetValue :: forall {a}. Read a => a
deviceSize :: forall {a}. Read a => a
deviceWidth :: forall {a}. Read a => a
deviceAddressUnitBits :: forall {a}. Read a => a
deviceVersion :: String
deviceName :: String
..}

-- loose version of svd that doesn't require device properties
svdPeripherals :: ArrowXml cat => cat (NTree XNode) [Peripheral]
svdPeripherals :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) [Peripheral]
svdPeripherals = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"device" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    [Peripheral]
devicePeripherals <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Peripheral
parsePeripheral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"peripherals" -< NTree XNode
x
    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< [Peripheral]
devicePeripherals

parsePeripheral :: ArrowXml cat => cat (NTree XNode) Peripheral
parsePeripheral :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Peripheral
parsePeripheral = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"peripheral" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    -- only these three avail for derived peripherals
    String
periphName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    Maybe String
periphDerivedFrom <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (forall a. Eq a => a -> a -> Bool
/= String
"") forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
att String
"derivedFrom") forall a. Maybe a
Nothing -< NTree XNode
x
    String
baseAddress' <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"baseAddress" -< NTree XNode
x

    String
desc <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"description") String
"" -< NTree XNode
x
    String
periphGroupName <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"groupName") String
"" -< NTree XNode
x
    Maybe AddressBlock
periphAddressBlock <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) AddressBlock
parseAddressBlock) forall a. Maybe a
Nothing -< NTree XNode
x

    [Interrupt]
periphInterrupts <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Interrupt
parseInterrupt -< NTree XNode
x

    [Register]
periphRegisters <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Register
parseRegister forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"registers") forall a. Monoid a => a
mempty -< NTree XNode
x
    [Cluster]
periphClusters <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Cluster
parseCluster forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"registers") forall a. Monoid a => a
mempty -< NTree XNode
x

    let periphBaseAddress :: a
periphBaseAddress = forall a. Read a => String -> a
read String
baseAddress'
        periphDescription :: String
periphDescription = String -> String
filterCrap String
desc

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Peripheral{String
[Register]
[Cluster]
[Interrupt]
Maybe String
Maybe AddressBlock
forall {a}. Read a => a
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphBaseAddress :: Int
periphGroupName :: String
periphDerivedFrom :: Maybe String
periphDescription :: String
periphName :: String
periphDescription :: String
periphBaseAddress :: forall {a}. Read a => a
periphClusters :: [Cluster]
periphRegisters :: [Register]
periphInterrupts :: [Interrupt]
periphAddressBlock :: Maybe AddressBlock
periphGroupName :: String
periphDerivedFrom :: Maybe String
periphName :: String
..}

parseAddressBlock
  :: ArrowXml cat
  => cat (NTree XNode) AddressBlock
parseAddressBlock :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) AddressBlock
parseAddressBlock = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"addressBlock" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    String
offset <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"offset" -< NTree XNode
x
    String
size <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"size" -< NTree XNode
x
    String
addressBlockUsage <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"usage" -< NTree XNode
x

    let addressBlockOffset :: a
addressBlockOffset = forall a. Read a => String -> a
read String
offset
        addressBlockSize :: a
addressBlockSize = forall a. Read a => String -> a
read String
size

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< AddressBlock{String
forall {a}. Read a => a
addressBlockUsage :: String
addressBlockSize :: Int
addressBlockOffset :: Int
addressBlockSize :: forall {a}. Read a => a
addressBlockOffset :: forall {a}. Read a => a
addressBlockUsage :: String
..}

parseInterrupt
  :: ArrowXml cat
  => cat (NTree XNode) Interrupt
parseInterrupt :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Interrupt
parseInterrupt = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"interrupt" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    String
name <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    String
desc <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"description" -< NTree XNode
x
    String
val <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"value" -< NTree XNode
x

    let interruptName :: String
interruptName = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toUpper String
name
        interruptValue :: a
interruptValue = forall a. Read a => String -> a
read String
val
        interruptDescription :: String
interruptDescription = String -> String
filterCrap String
desc

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Interrupt{String
forall {a}. Read a => a
interruptValue :: Int
interruptDescription :: String
interruptName :: String
interruptDescription :: String
interruptValue :: forall {a}. Read a => a
interruptName :: String
..}

parseCluster
  :: ArrowXml cat
  => cat (NTree XNode) Cluster
parseCluster :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Cluster
parseCluster = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"cluster" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    String
clusterName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    String
clusterDescription <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"description" -< NTree XNode
x
    Maybe Dimension
clusterDimension <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just  forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Dimension
parseDimension) forall a. Maybe a
Nothing -< NTree XNode
x
    String
offset <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"addressOffset" -< NTree XNode
x
    [Register]
clusterRegisters <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Register
parseRegister -< NTree XNode
x
    [Cluster]
clusterNested <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Cluster
parseCluster -< NTree XNode
x

    let clusterAddressOffset :: a
clusterAddressOffset = forall a. Read a => String -> a
read String
offset
    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Cluster{String
[Register]
[Cluster]
Maybe Dimension
forall {a}. Read a => a
clusterNested :: [Cluster]
clusterRegisters :: [Register]
clusterAddressOffset :: Int
clusterDescription :: String
clusterDimension :: Maybe Dimension
clusterName :: String
clusterAddressOffset :: forall {a}. Read a => a
clusterNested :: [Cluster]
clusterRegisters :: [Register]
clusterDimension :: Maybe Dimension
clusterDescription :: String
clusterName :: String
..}

parseDimension
  :: ArrowXml cat
  => cat (NTree XNode) Dimension
parseDimension :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Dimension
parseDimension =
  proc NTree XNode
x -> do
    String
dim <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"dim" -< NTree XNode
x
    String
dimIncr <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"dimIncrement" -< NTree XNode
x
    String
dimIdx <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"dimIndex" -< NTree XNode
x

    let
      dimensionSize :: a
dimensionSize = forall a. Read a => String -> a
read String
dim
      dimensionIncrement :: a
dimensionIncrement = forall a. Read a => String -> a
read String
dimIncr
      dimensionIndex :: DimensionIndex
dimensionIndex = case String
dimIdx of
        String
i | Char
'-' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
i -> case String -> [String]
words [ if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
c | Char
c <- String
i ] of
          [String
from, String
to] -> Int -> Int -> DimensionIndex
DimensionIndex_FromTo (forall a. Read a => String -> a
read String
from) (forall a. Read a => String -> a
read String
to)
          [String]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Don't know how to handle ranged dimIndex: " forall a. Semigroup a => a -> a -> a
<> String
i
        String
i | Char
',' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
i -> [String] -> DimensionIndex
DimensionIndex_List forall a b. (a -> b) -> a -> b
$ String -> [String]
words [ if Char
c forall a. Eq a => a -> a -> Bool
== Char
',' then Char
' ' else Char
c | Char
c <- String
i ]
        String
i | Bool
otherwise -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Don't know how to handle dimIndex: " forall a. Semigroup a => a -> a -> a
<> String
i
    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Dimension{DimensionIndex
forall {a}. Read a => a
dimensionIndex :: DimensionIndex
dimensionIncrement :: Int
dimensionSize :: Int
dimensionIndex :: DimensionIndex
dimensionIncrement :: forall {a}. Read a => a
dimensionSize :: forall {a}. Read a => a
..}

parseRegister
  :: ArrowXml cat
  => cat (NTree XNode) Register
parseRegister :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Register
parseRegister = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"register" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    String
regName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    String
regDisplayName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTagOrEmpty String
"displayName" -< NTree XNode
x
    String
desc <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTagOrEmpty String
"description" -< NTree XNode
x

    String
offset <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"addressOffset" -< NTree XNode
x
    String
size <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"size" -< NTree XNode
x
    String
access <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"access") String
"read-write" -< NTree XNode
x

    Maybe Int
regResetValue <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"resetValue") forall a. Maybe a
Nothing -< NTree XNode
x
    [Field]
regFields <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Field
parseField forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"fields") [] -< NTree XNode
x

    Maybe Dimension
regDimension <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just  forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Dimension
parseDimension) forall a. Maybe a
Nothing -< NTree XNode
x

    let regAddressOffset :: a
regAddressOffset = forall a. Read a => String -> a
read String
offset
        regSize :: a
regSize = forall a. Read a => String -> a
read String
size
        regAccess :: AccessType
regAccess = String -> AccessType
toAccessType String
access
        regDescription :: String
regDescription = String -> String
filterCrap String
desc

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Register{String
[Field]
Maybe Int
Maybe Dimension
AccessType
forall {a}. Read a => a
regFields :: [Field]
regResetValue :: Maybe Int
regAccess :: AccessType
regSize :: Int
regAddressOffset :: Int
regDescription :: String
regDimension :: Maybe Dimension
regDisplayName :: String
regName :: String
regDescription :: String
regAccess :: AccessType
regSize :: forall {a}. Read a => a
regAddressOffset :: forall {a}. Read a => a
regDimension :: Maybe Dimension
regFields :: [Field]
regResetValue :: Maybe Int
regDisplayName :: String
regName :: String
..}

parseField
  :: ArrowXml cat
  => cat (NTree XNode) Field
parseField :: forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Field
parseField = forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) (NTree XNode)
atTag String
"field" forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  proc NTree XNode
x -> do
    String
fieldName <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"name" -< NTree XNode
x
    Maybe Dimension
fieldDimension <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Maybe a
Just  forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
cat (NTree XNode) Dimension
parseDimension) forall a. Maybe a
Nothing -< NTree XNode
x
    String
desc <- forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTagOrEmpty String
"description" -< NTree XNode
x

    Maybe Int
bitOffsetMay <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"bitOffset") forall a. Maybe a
Nothing -< NTree XNode
x
    Maybe Int
bitWidthMay <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"bitWidth") forall a. Maybe a
Nothing -< NTree XNode
x

    -- bitRange [MSB:LSB]
    Maybe (Int, Int)
bitRange <- forall (a :: * -> * -> *) b c. ArrowList a => a b c -> c -> a b c
withDefault (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int)
splitRange) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (cat :: * -> * -> *).
ArrowXml cat =>
String -> cat (NTree XNode) String
textAtTag String
"bitRange") forall a. Maybe a
Nothing -< NTree XNode
x

    -- XXX: TODO: one more possibility is lsb msb tags format, handle if needed

    let errmsg :: a
errmsg = forall a. HasCallStack => String -> a
error String
"Neither bitRange nor bitOffset + bitWidth defined"
        (Int
fieldBitOffset, Int
fieldBitWidth) = case Maybe (Int, Int)
bitRange of
            Maybe (Int, Int)
Nothing -> ( forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe forall {a}. a
errmsg Maybe Int
bitOffsetMay
                        , forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe forall {a}. a
errmsg Maybe Int
bitWidthMay)
            Just (Int
msb, Int
lsb) -> (Int
lsb, Int
msb forall a. Num a => a -> a -> a
- Int
lsb forall a. Num a => a -> a -> a
+ Int
1)

        fieldDescription :: String
fieldDescription = String -> String
filterCrap String
desc
        fieldReserved :: Bool
fieldReserved = Bool
False
        fieldRegType :: Maybe a
fieldRegType = forall a. Maybe a
Nothing

    forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Field{Bool
Int
String
Maybe Dimension
forall a. Maybe a
fieldRegType :: Maybe String
fieldReserved :: Bool
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldDescription :: String
fieldName :: String
fieldRegType :: forall a. Maybe a
fieldReserved :: Bool
fieldDescription :: String
fieldBitWidth :: Int
fieldBitOffset :: Int
fieldDimension :: Maybe Dimension
fieldName :: String
..}
    where
      splitRange :: String -> (Int, Int)
      splitRange :: String -> (Int, Int)
splitRange String
r = (forall a. (HasCallStack, Read a) => String -> String -> a
readNote String
"splitRange" forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
':') String
raw,
                      forall a. (HasCallStack, Read a) => String -> String -> a
readNote String
"splitRange" forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
':') String
raw)
        where
          raw :: String
raw = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init String
r