Add support for "date" and "time_ms" logical types in Avro (#114)

Co-authored-by: Flavio Corpa <[email protected]>

adapter/avro/mu-avro.cabal

@@ -22,6 +22,7 @@ source-repository head
 
 library
   exposed-modules:
+    Data.Time.Millis
     Mu.Adapter.Avro
     Mu.Quasi.Avro
     Mu.Quasi.Avro.Example
@@ -32,6 +33,7 @@ library
     , base                  >=4.12  && <5
     , bytestring
     , containers
+    , deepseq
     , language-avro         >=0.1.1
     , mu-rpc                >=0.2.0
     , mu-schema             >=0.2.0

adapter/avro/src/Data/Time/Millis.hs

@@ -0,0 +1,41 @@
+{-# language GeneralizedNewtypeDeriving #-}
+module Data.Time.Millis where
+
+
+import           Control.DeepSeq         (NFData)
+import           Data.Avro.Encode
+import           Data.Avro.EncodeRaw
+import           Data.Avro.FromAvro
+import           Data.Avro.HasAvroSchema
+import           Data.Avro.Schema        as S
+import           Data.Avro.ToAvro
+import           Data.Avro.Types         as T
+import           Data.Tagged
+import           Data.Time
+import           Unsafe.Coerce
+
+-- | Wrapper for time difference expressed in milliseconds
+newtype DiffTimeMs = DiffTimeMs { unDiffTimeMs :: DiffTime }
+  deriving (Show, Eq, Ord, Enum, Num, Fractional, Real, RealFrac, NFData)
+
+instance EncodeAvro DiffTimeMs where
+  avro d
+      -- Unfortunately, the AvroM constructor is not exposed :(
+    = unsafeCoerce ( encodeRaw (fromIntegral $ diffTimeToMillis d :: Int)
+                   , S.Long (Just TimeMicros) )
+
+instance HasAvroSchema DiffTimeMs where
+  schema = Tagged $ S.Int (Just TimeMillis)
+
+instance ToAvro DiffTimeMs where
+  toAvro = T.Int . fromIntegral . diffTimeToMillis
+
+instance FromAvro DiffTimeMs where
+  fromAvro (T.Int  v) = pure $ millisToDiffTime (toInteger v)
+  fromAvro v          = badValue v "TimeMicros"
+
+diffTimeToMillis :: DiffTimeMs -> Integer
+diffTimeToMillis = (`div` 1000000000) . diffTimeToPicoseconds . unDiffTimeMs
+
+millisToDiffTime :: Integer -> DiffTimeMs
+millisToDiffTime = DiffTimeMs . picosecondsToDiffTime . (* 1000000000)

adapter/avro/src/Mu/Quasi/Avro.hs

@@ -36,6 +36,7 @@ import           Data.Int
 import qualified Data.Set                   as S
 import qualified Data.Text                  as T
 import           Data.Time
+import           Data.Time.Millis
 import           Data.UUID
 import qualified Data.Vector                as V
 import           Language.Avro.Parser
@@ -123,6 +124,7 @@ schemaFromAvroType =
     A.Null -> [t|'TPrimitive 'TNull|]
     A.Boolean -> [t|'TPrimitive Bool|]
     A.Int (Just A.Date) -> [t|'TPrimitive Day|]
+    A.Int (Just A.TimeMillis) -> [t|'TPrimitive DiffTimeMs|]
     A.Int _ -> [t|'TPrimitive Int32|]
     A.Long (Just (A.DecimalL (A.Decimal p s)))
              -> [t|'TPrimitive (D.Decimal $(litT $ numTyLit p) $(litT $ numTyLit s)) |]

default.nix

@@ -1,5 +1,5 @@
 { nixpkgs ? (fetchTarball https://github.com/NixOS/nixpkgs/archive/484ea7bbac5bf7f958b0bb314a3c130b6c328800.tar.gz)
-, pkgs ? import nixpkgs (import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/21c5528.tar.gz))
+, pkgs ? import nixpkgs (import (builtins.fetchTarball https://github.com/input-output-hk/haskell.nix/archive/3db580a.tar.gz))
 }:
 
 let

stack-nightly.yaml

@@ -1,4 +1,4 @@
-resolver: nightly-2020-02-25
+resolver: nightly-2020-02-28
 allow-newer: true
 
 packages:
@@ -30,7 +30,7 @@ extra-deps:
 - http2-client-grpc-0.8.0.0
 - avro-0.4.7.0
 - language-protobuf-1.0.1
-- language-avro-0.1.1.0
+- language-avro-0.1.2.0
 - hw-kafka-client-3.0.0
 - hw-kafka-conduit-2.6.0
 - HasBigDecimal-0.1.1

stack.yaml

@@ -30,7 +30,7 @@ extra-deps:
 - http2-client-grpc-0.8.0.0
 - avro-0.4.7.0
 - language-protobuf-1.0.1
-- language-avro-0.1.1.0
+- language-avro-0.1.2.0
 - hw-kafka-client-3.0.0
 - hw-kafka-conduit-2.6.0
 - HasBigDecimal-0.1.1