module Fit.Messages (
readMessages,
readFileMessages,
parseMessages,
Messages(..),
Message(..),
Field(..),
Value(..),
SingletonValue(..),
ArrayValue(..)
) where
import qualified Fit.Internal.FitFile as Raw
import qualified Fit.Internal.Parse as Raw
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)
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 <$> Raw.readFitRaw bs
readFileMessages :: FilePath -> IO (Either String Messages)
readFileMessages fp = B.readFile fp >>= return . readMessages
parseMessages :: Parser Messages
parseMessages = fmap toMessages Raw.parseFit
toMessages :: Raw.Fit -> Messages
toMessages rFit = Messages . S.fromList . catMaybes $ fmap toMessage (Raw.fMessages rFit)
toMessage :: Raw.Message -> Maybe Message
toMessage (Raw.DefM _) = Nothing
toMessage (Raw.DataM _ gmt fields) = Just $ Message gmt (foldr go Map.empty fields)
where go f@(Raw.SingletonField num _) fieldMap = Map.insert num (toField f) fieldMap
go f@(Raw.ArrayField num _) fieldMap = Map.insert num (toField f) fieldMap
toField :: Raw.Field -> Field
toField (Raw.SingletonField num value) = Field num . Singleton $ (fromSingletonValue value)
toField (Raw.ArrayField num array) = Field num . Array $ (fromArray array)
fromSingletonValue :: Raw.Value -> SingletonValue
fromSingletonValue v =
case v of
Raw.EnumValue i -> IntValue (fromIntegral i)
Raw.SInt8Value i -> IntValue (fromIntegral i)
Raw.UInt8Value i -> IntValue (fromIntegral i)
Raw.SInt16Value i -> IntValue (fromIntegral i)
Raw.UInt16Value i -> IntValue (fromIntegral i)
Raw.SInt32Value i -> IntValue (fromIntegral i)
Raw.UInt32Value i -> IntValue (fromIntegral i)
Raw.StringValue t -> TextValue t
Raw.Float32Value f -> RealValue (fromRational (toRational f))
Raw.Float64Value f -> RealValue f
Raw.UInt8ZValue i -> IntValue (fromIntegral i)
Raw.UInt16ZValue i -> IntValue (fromIntegral i)
Raw.UInt32ZValue i -> IntValue (fromIntegral i)
Raw.ByteValue b -> ByteValue b
fromArray :: Raw.Array -> ArrayValue
fromArray a =
case a of
Raw.EnumArray xs -> intArray xs
Raw.SInt8Array xs -> intArray xs
Raw.UInt8Array xs -> intArray xs
Raw.SInt16Array xs -> intArray xs
Raw.UInt16Array xs -> intArray xs
Raw.SInt32Array xs -> intArray xs
Raw.UInt32Array xs -> intArray xs
Raw.Float32Array xs -> realArray xs
Raw.Float64Array xs -> realArray xs
Raw.UInt8ZArray xs -> intArray xs
Raw.UInt16ZArray xs -> intArray xs
Raw.UInt32ZArray xs -> intArray xs
Raw.ByteArray bs -> ByteArray . B.pack $ F.toList bs
where intArray is = IntArray $ fmap fromIntegral is
realArray rs = RealArray $ fmap (fromRational . toRational) rs