module Fit.Messages (
readMessages,
readFileMessages,
parseMessages,
Messages(..),
Message(..),
Field(..),
Value(..),
SingletonValue(..),
ArrayValue(..)
) where
import qualified Fit.Internal.FitFile as FF
import qualified Fit.Internal.Parse as FF
import Control.Applicative
import Data.Attoparsec.ByteString (Parser)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B (readFile, pack)
import qualified Data.Foldable as F (toList)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as Map (empty, insert)
import Data.Maybe (catMaybes)
import Data.Sequence (Seq)
import qualified Data.Sequence as S (fromList)
import Data.Text (Text)
import Data.Word (Word8)
import Prelude
newtype Messages = Messages {
_messages :: Seq Message
} deriving (Show)
data Message = Message {
_mNumber :: !Int,
_mFields :: IntMap Field
} deriving (Show)
data Field = Field {
_fNumber :: !Int,
_fValue :: Value
} deriving (Show)
data Value = Singleton SingletonValue
| Array ArrayValue
deriving (Show)
data SingletonValue = IntValue !Int
| RealValue !Double
| ByteValue !Word8
| TextValue Text
deriving (Show)
data ArrayValue = IntArray (Seq Int)
| RealArray (Seq Double)
| ByteArray ByteString
deriving (Show)
readMessages :: ByteString -> Either String Messages
readMessages bs = toMessages <$> FF.readFitRaw bs
readFileMessages :: FilePath -> IO (Either String Messages)
readFileMessages fp = B.readFile fp >>= return . readMessages
parseMessages :: Parser Messages
parseMessages = fmap toMessages FF.parseFit
toMessages :: FF.Fit -> Messages
toMessages rFit = Messages . S.fromList . catMaybes $ fmap toMessage (FF.fMessages rFit)
toMessage :: FF.Message -> Maybe Message
toMessage (FF.DefM _) = Nothing
toMessage (FF.DataM _ gmt fields) = Just $ Message gmt (foldr go Map.empty fields)
where go f@(FF.SingletonField num _) fieldMap = Map.insert num (toField f) fieldMap
go f@(FF.ArrayField num _) fieldMap = Map.insert num (toField f) fieldMap
toField :: FF.Field -> Field
toField (FF.SingletonField num value) = Field num . Singleton $ (fromSingletonValue value)
toField (FF.ArrayField num array) = Field num . Array $ (fromArray array)
fromSingletonValue :: FF.Value -> SingletonValue
fromSingletonValue v =
case v of
FF.EnumValue i -> IntValue (fromIntegral i)
FF.SInt8Value i -> IntValue (fromIntegral i)
FF.UInt8Value i -> IntValue (fromIntegral i)
FF.SInt16Value i -> IntValue (fromIntegral i)
FF.UInt16Value i -> IntValue (fromIntegral i)
FF.SInt32Value i -> IntValue (fromIntegral i)
FF.UInt32Value i -> IntValue (fromIntegral i)
FF.StringValue t -> TextValue t
FF.Float32Value f -> RealValue (fromRational (toRational f))
FF.Float64Value f -> RealValue f
FF.UInt8ZValue i -> IntValue (fromIntegral i)
FF.UInt16ZValue i -> IntValue (fromIntegral i)
FF.UInt32ZValue i -> IntValue (fromIntegral i)
FF.ByteValue b -> ByteValue b
fromArray :: FF.Array -> ArrayValue
fromArray a =
case a of
FF.EnumArray xs -> intArray xs
FF.SInt8Array xs -> intArray xs
FF.UInt8Array xs -> intArray xs
FF.SInt16Array xs -> intArray xs
FF.UInt16Array xs -> intArray xs
FF.SInt32Array xs -> intArray xs
FF.UInt32Array xs -> intArray xs
FF.Float32Array xs -> realArray xs
FF.Float64Array xs -> realArray xs
FF.UInt8ZArray xs -> intArray xs
FF.UInt16ZArray xs -> intArray xs
FF.UInt32ZArray xs -> intArray xs
FF.ByteArray bs -> ByteArray . B.pack $ F.toList bs
where intArray is = IntArray $ fmap fromIntegral is
realArray rs = RealArray $ fmap (fromRational . toRational) rs