module Data.CMX.Parse where
import Control.Monad
import Control.Arrow.ArrowList
import Text.XML.HXT.Core
import qualified Data.Char as Char
import qualified Data.Set as Set
import Data.Maybe
import Data.CMX.Types
atTag tag = deep (isElem >>> hasName tag)
text = getChildren >>> getText
textAtTag tag = text <<< atTag tag
att = getAttrValue
attNE x = (getAttrValue x >>> isA (/= ""))
attMaybe attname tagname = withDefault (arr Just <<< attNE attname <<< atTag tagname) Nothing
capitalized :: String -> String
capitalized (head:tail) = Char.toUpper head : map Char.toLower tail
capitalized [] = []
getDBVerRel = atTag "Package" >>>
proc x -> do
version <- getAttrValue "DBVersion" -< x
release <- getAttrValue "Release" <<< deep (atTag "PackDescription") -< x
returnA -< (version, release)
getDB = atTag "family" >>>
proc x -> do
name <- getAttrValue "name" -< x
core <- text <<< atTag "CPUcore" -< x
header <- text <<< atTag "header" -< x
families <- listA subFamily -< x
returnA -< (name, core, families)
subFamily = atTag "subFamily" >>>
proc x -> do
name <- getAttrValue "name" -< x
fpu <- getAttrValue "fpu" -< x
clock <- getAttrValue "clock" -< x
devices <- listA device -< x
returnA -< (name, fpu, clock, devices)
device = atTag "device" >>>
proc x -> do
partNumbers <- text <<< atTag "PN" -< x
variants <- text <<< atTag "variants" -< x
memories <- listA (memory "") -< x
memoriesITCM <- listA (memory "ITCM") -< x
header <- text <<< atTag "header" -< x
returnA -< (partNumbers, variants, memories, memoriesITCM, header)
memory t = atTag ("memory" ++ t) >>>
proc x -> do
name <- att "name" -< x
access <- att "access" -< x
start <- att "start" -< x
size <- att "size" -< x
returnA -< (name, access, start, size)
mcu = atTag "Mcu" >>>
proc x -> do
mcuClockTree <- att "ClockTree" -< x
mcuDbVersion <- att "DBVersion" -< x
mcuFamily <- att "Family" -< x
mcuIoType <- att "IOType" -< x
mcuLine <- att "Line" -< x
mcuPackage <- att "Package" -< x
mcuRefName <- att "RefName" -< x
mcuFrequency <- withDefault (arr (Just . read) <<< textAtTag "Frequency") Nothing -< x
mcuDie <- textAtTag "Die" -< x
mcuCcmRam <- withDefault (arr (Just . read) <<< textAtTag "CCMRam") Nothing -< x
mcuCore <- textAtTag "Core" -< x
hasPowerPad' <- att "HasPowerPad" -< x
ramVariants' <- listA (textAtTag "Ram") -< x
flashVariants' <- listA (textAtTag "Flash") -< x
numberOfIO' <- textAtTag "IONb" -< x
voltageMin <- attMaybe "Min" "Voltage" -< x
voltageMax <- attMaybe "Max" "Voltage" -< x
temperatureMin <- attMaybe "Min" "Temperature" -< x
temperatureMax <- attMaybe "Max" "Temperature" -< x
currentLowest <- attMaybe "Lowest" "Current"-< x
currentRun <- attMaybe "Run" "Current" -< x
ips' <- listA ip -< x
pins' <- listA pin -< x
let
mcuIps = Set.fromList ips'
mcuPins = Set.fromList pins'
mcuRamVariants = map read ramVariants'
mcuFlashVariants = map read flashVariants'
mcuHasPowerPad = read $ capitalized hasPowerPad'
mcuNumberOfIO = read numberOfIO'
mcuLimits = catMaybes [
maybe Nothing (Just . Limit Min Voltage . read) voltageMin
, maybe Nothing (Just . Limit Max Voltage . read) voltageMax
, maybe Nothing (Just . Limit Min Temperature . read) temperatureMin
, maybe Nothing (Just . Limit Max Temperature . read) temperatureMax
, maybe Nothing (Just . Limit Lowest Current . read) currentLowest
, maybe Nothing (Just . Limit Run Current . read) currentRun
]
returnA -< MCU{..}
ip = atTag "IP" >>>
proc x -> do
ipName <- att "Name" -< x
ipVersion <- att "Version" -< x
ipConfigFile <- att "ConfigFile" -< x
ipClockEnableMode <- att "clockEnableMode" -< x
ipInstanceName <- att "InstanceName" -< x
returnA -< IP{..}
pin = atTag "Pin" >>>
proc x -> do
pinName <- att "Name" -< x
pinPosition <- att "Position" -< x
pinType <- att "Type" -< x
pinSignals <- listA signal -< x
returnA -< Pin{..}
signal = atTag "Signal" >>>
proc x -> do
sigName <- att "Name" -< x
sigIOModes <- att "IOModes" -< x
returnA -< Signal{..}
parseMCU f = do
res <- runX (readDocument [] f >>> mcu)
case res of
[] -> return $ Left "no mcu parsed"
[x] -> return $ Right x
_ -> return $ Left "multiple mcus parsed"