ecu-0.0.6: src/CANViewDecompose.hs
module Main (main) where
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.Char
import Data.List
import Data.Word
import Text.Printf
import System.Environment
import CANData
import CANDB
import J1939Data
data J1939Info = J1939Info
{ msg_id :: Word32
, priority :: Word8
, edp :: Word8
, dp :: Word8
, pf :: Word8
, ge :: Word8
, pgn :: Word32
, sa :: Word8
, da :: Word8
} deriving (Show, Ord, Eq)
main :: IO ()
main = do
args <- getArgs
case args of
["-h"] -> help
["--help"] -> help
[] -> processCANViewLine
_ -> help
help :: IO ()
help = putStrLn $ unlines
[ ""
, "NAME"
, " decomp - decompose J1939 messages from 'canview'"
, ""
, "EXAMPLE"
, " canview | decomp"
, " OR"
, " decomp < canview.log"
, ""
]
processCANViewLine :: IO ()
processCANViewLine = do
line <- BS.getLine
decomposeLine line
processCANViewLine
decomposeLine :: BS.ByteString -> IO ()
decomposeLine line = do
BS.putStrLn line
printTime (getTime line)
printMsgInfo msgInfo
decomposePayload msgInfo (getPayload line)
BS.putStrLn (BS.pack "")
where
msgInfo = getInfo (getID line)
decomposePayload :: J1939Info -> [Word8] -> IO ()
--decomposePayload _ payload = printBytes payload
decomposePayload info payload = case (getCANMsg info) of
Nothing -> BS.putStrLn bs0
where
bs0 = BS.pack $ concat
[ "<Unknown>:"
, concatMap formatHexBytes payload
]
Just thisMsg -> do
BS.putStrLn bs0
mapM_ (decomposeSignal payload) (canMsgSignals thisMsg)
where
bs0 = BS.pack $ concat
[ printf "%s:" messageName
, concatMap formatHexBytes payload
]
messageName = canMsgName thisMsg
formatHexBytes :: Word8 -> String
formatHexBytes x = printf " %02X" x
decomposeSignal :: [Word8] -> CANSignal -> IO ()
decomposeSignal payload thisSignal = BS.putStrLn bs0
where
bs0 = BS.pack (printf (" %s: " ++ numberFmt) name signal)
name = canSignalName thisSignal
signal = decodeSignal payload thisSignal
numberFmt = case (canSignalFactor thisSignal) of
1.0 -> "%.0f"
_ -> "%f"
decodeSignal :: [Word8] -> CANSignal -> Float
decodeSignal payload signal = (fromIntegral binaryValue) * factor + offset
where
binaryValue = case (canSignalEndian signal) of
CANBigEndian -> getBinaryValueBE word64 signal
CANLittleEndian -> getBinaryValueLE word64 signal
factor = canSignalFactor signal
offset = canSignalOffset signal
word64 = toWord64 payload
getBinaryValueLE :: Word64 -> CANSignal -> Word64
getBinaryValueLE word64 signal = tmp2 .&. mask
where
tmp = shiftR word64 ((7 - endByte) * 8)
tmp1 = rearrangeBytesLEtoBE tmp numBytes
tmp2 = shiftR tmp1 (mod startBit 8)
mask = (shiftL 1 bitLength) - 1
numBytes = 1 + (endByte - startByte)
startByte = div startBit 8
endByte = div (startBit + bitLength -1) 8
bitLength = fromIntegral $ canSignalBitLength signal
startBit = fromIntegral $ canSignalStartBit signal
getBinaryValueBE :: Word64 -> CANSignal -> Word64
getBinaryValueBE word64 signal = shiftedValue .&. mask
where
shiftedValue = shiftR word64 (getShiftAmount signal)
mask = (shiftL 1 bitLength) - 1
bitLength = fromIntegral $ canSignalBitLength signal
getShiftAmount :: CANSignal -> Int
getShiftAmount signal = 64 - bitLength - ((div startBit 8) * 8 + (7 - (mod startBit 8)))
where
bitLength = fromIntegral $ canSignalBitLength signal
startBit = fromIntegral $ canSignalStartBit signal
rearrangeBytesLEtoBE :: Word64 -> Int -> Word64
rearrangeBytesLEtoBE word64 numBytes = toWord64 rearranged
where
desiredBytes = drop (8 - numBytes) (fromWord64 word64)
numDontCare = 8 - numBytes
rearranged = (replicate numDontCare 0xFF) ++ (reverse desiredBytes)
getCANMsg :: J1939Info -> Maybe CANMsg
getCANMsg info = find (isSamePGN (msg_id info)) (canDbMsgs canDB)
isSamePGN :: Word32 -> CANMsg -> Bool
isSamePGN matchID thisMsg = matchPGN == thisPGN
where
thisPGN = getParameterGroupNumber thisID
matchPGN = getParameterGroupNumber matchID
thisID = canMsgId thisMsg
--printBytes :: [Word8] -> IO ()
--printBytes payload = do
-- BS.putStrLn bs0
-- mapM_ printByte (zip [ 1 .. ] payload)
-- where
-- bs0 = BS.pack (printf " Payload:")
--
--printByte :: (Int, Word8) -> IO ()
--printByte (index, byte) = BS.putStrLn bs0
-- where
-- bs0 = BS.pack (printf " Byte%d: %02X" index byte)
getInfo :: Word32 -> J1939Info
getInfo x = J1939Info
{ msg_id = x
, priority = getPriority x
, edp = getExtendedDataPage x
, dp = getDataPage x
, pf = pduFormat
, ge = globalExtension
, pgn = getParameterGroupNumber x
, sa = getSourceAddress x
, da = getDestinationAddress x
}
where
pduFormat = getPDUFormat x
globalExtension = getGlobalExtension x
getPriority :: Word32 -> Word8
getPriority x = fromIntegral $ (shiftR x 26) .&. 0x7
getExtendedDataPage :: Word32 -> Word8
getExtendedDataPage x = fromIntegral $ (shiftR x 25) .&. 0x1
getDataPage :: Word32 -> Word8
getDataPage x = fromIntegral $ (shiftR x 24) .&. 0x1
getPDUFormat :: Word32 -> Word8
getPDUFormat x = fromIntegral $ (shiftR x 16) .&. 0xFF
getGlobalExtension :: Word32 -> Word8
getGlobalExtension x = fromIntegral $ (shiftR x 8) .&. 0xFF
getSourceAddress :: Word32 -> Word8
getSourceAddress x = fromIntegral $ x .&. 0xFF
getParameterGroupNumber :: Word32 -> Word32
getParameterGroupNumber x = if (getPDUFormat x) < 240
then (shiftR x 8) .&. 0x3FF00
else (shiftR x 8) .&. 0x3FFFF
getDestinationAddress :: Word32 -> Word8
getDestinationAddress x = if (getPDUFormat x) < 240
then (getGlobalExtension x)
else 0xFE
getItems :: [BS.ByteString] -> BS.ByteString -> [BS.ByteString]
getItems bss bs = case BS.null bs of
True -> bss
False -> getItems (bss ++ [nextItem]) rest
where
(nextItem, rest) = BS.span (not . isSpace) noLeadingSpace
noLeadingSpace = BS.dropWhile isSpace bs
getTime :: BS.ByteString -> Word32
getTime bs = read (BS.unpack (items !! 0))
where
items = getItems [] bs
getID :: BS.ByteString -> Word32
getID bs = read (BS.unpack (items !! 1))
where
items = getItems [] bs
getPayload :: BS.ByteString -> [Word8]
getPayload bs = map read (map BS.unpack hexBytes)
where
hexBytes = map (BS.append searchPrefix) (hexPairs hexBS)
hexBS = case (BS.isPrefixOf searchPrefix payloadBS) of
True -> BS.drop 2 payloadBS
False -> payloadBS
searchPrefix = BS.pack "0x"
payloadBS = items !! 2
items = getItems [] bs
hexPairs :: BS.ByteString -> [BS.ByteString]
hexPairs bs
| BS.null bs = []
| otherwise = BS.take 2 bs : hexPairs (BS.drop 2 bs)
printTime :: Word32 -> IO ()
printTime time = BS.putStrLn bs
where
bs = BS.pack (printf "Time: %9.3f" ms)
ms = ((fromIntegral time) :: Double) / 1000.0
printMsgInfo :: J1939Info -> IO ()
printMsgInfo info = do
BS.putStrLn bs0
BS.putStrLn bs1
BS.putStrLn bs2
BS.putStrLn bs3
BS.putStrLn bs4
BS.putStrLn bs5
BS.putStrLn bs6
BS.putStrLn bs7
BS.putStrLn bs8
where
bs0 = BS.pack (printf "Msg ID: 0x%08X" (msg_id info))
bs1 = BS.pack (printf " Priority: %d" (priority info))
bs2 = BS.pack (printf " ExtendedDataPage: %d" (edp info))
bs3 = BS.pack (printf " DataPage: %d" (dp info))
bs4 = BS.pack (printf " PDU Format: %d" (pf info))
bs5 = BS.pack (printf " Global Extension: %d" (ge info))
bs6 = BS.pack (printf " PGN: 0x%06X" (pgn info))
bs7 = BS.pack (printf " Source Address: %d (%s)" (sa info) saName)
bs8 = BS.pack (printf " Destination Address: %d (%s)" (da info) daName)
saName = case (lookup (sa info) sourceAddressTable) of
Nothing -> error (printf "couldn't find name for source address 0x%02x" (sa info))
Just name -> name
daName = case (lookup (da info) sourceAddressTable) of
Nothing -> error (printf "couldn't find name for destination address 0x%02x" (da info))
Just name -> name