FromAvro.hs

{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Avro.FromAvro

where

import           Control.Arrow           (first)
import           Control.Monad.Identity  (Identity(..))
import qualified Data.Avro.Encode        as E
import           Data.Avro.HasAvroSchema
import           Data.Avro.Schema        as S
import           Data.Avro.Types         as T
import           Data.Avro.Types.Decimal as D
import           Data.Avro.Types.Time
import qualified Data.ByteString         as B
import           Data.ByteString.Lazy    (ByteString)
import qualified Data.ByteString.Lazy    as BL
import           Data.Foldable           (toList)
import qualified Data.HashMap.Strict     as HashMap
import           Data.Int
import           Data.List.NonEmpty      (NonEmpty (..))
import qualified Data.Map                as Map
import           Data.Monoid             ((<>))
import           Data.Tagged
import           Data.Text               (Text)
import qualified Data.Text               as Text
import qualified Data.Text.Lazy          as TL
import qualified Data.Time               as Time
import qualified Data.UUID               as UUID
import qualified Data.Vector             as V
import qualified Data.Vector.Unboxed     as U
import           Data.Word
import           GHC.TypeLits

class HasAvroSchema a => FromAvro a where
  fromAvro :: Value Schema -> Result a

(.:) :: FromAvro a => HashMap.HashMap Text (Value Schema) -> Text -> Result a
(.:) obj key =
  case HashMap.lookup key obj of
    Nothing -> fail $ "Requested field not available: " <> show key
    Just v  -> fromAvro v

instance (FromAvro a) => FromAvro (Identity a) where
  fromAvro e@(T.Union _ branch x)
    | S.matches branch sch = Identity <$> fromAvro x
    | otherwise            = badValue e "Identity"
    where Tagged sch = schema :: Tagged a Schema
  fromAvro x = badValue x "Identity"

instance (FromAvro a, FromAvro b) => FromAvro (Either a b) where
  fromAvro e@(T.Union _ branch x)
    | S.matches branch schemaA = Left  <$> fromAvro x
    | S.matches branch schemaB = Right <$> fromAvro x
    | otherwise              = badValue e "Either"
    where Tagged schemaA = schema :: Tagged a Schema
          Tagged schemaB = schema :: Tagged b Schema
  fromAvro x = badValue x "Either"

instance FromAvro Bool where
  fromAvro (T.Boolean b) = pure b
  fromAvro v             = badValue v "Bool"

instance FromAvro B.ByteString where
  fromAvro (T.Bytes b) = pure b
  fromAvro v           = badValue v "ByteString"

instance FromAvro BL.ByteString where
  fromAvro (T.Bytes b) = pure (BL.fromStrict b)
  fromAvro v           = badValue v "Lazy ByteString"

instance FromAvro Int where
  fromAvro (T.Int i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)
                      = pure (fromIntegral i)
  fromAvro (T.Long i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)
                      = pure (fromIntegral i)
  fromAvro v          = badValue v "Int"

instance FromAvro Int32 where
  fromAvro (T.Int i) = pure (fromIntegral i)
  fromAvro v         = badValue v "Int32"

instance FromAvro Int64 where
  fromAvro (T.Long i) = pure i
  fromAvro (T.Int i)  = pure (fromIntegral i)
  fromAvro v          = badValue v "Int64"

instance FromAvro Double where
  fromAvro (T.Double d) = pure d
  fromAvro v            = badValue v "Double"

instance FromAvro Float where
  fromAvro (T.Float f) = pure f
  fromAvro v           = badValue v "Float"

instance (KnownNat p, KnownNat s) => FromAvro (D.Decimal p s) where
  fromAvro (T.Long n) = pure $ D.fromUnderlyingValue $ fromIntegral n
  fromAvro (T.Int  n) = pure $ D.fromUnderlyingValue $ fromIntegral n
  fromAvro v          = badValue v "Decimal"

instance FromAvro UUID.UUID where
  fromAvro v@(T.String s)
    = case UUID.fromText s of
        Nothing -> badValue v "UUID"
        Just u  -> pure u
  fromAvro v = badValue v "UUID"

instance FromAvro Time.Day where
  fromAvro (T.Int  v) = pure $ fromDaysSinceEpoch (toInteger v)
  fromAvro (T.Long v) = pure $ fromDaysSinceEpoch (toInteger v)
  fromAvro v = badValue v "Date"

instance FromAvro Time.DiffTime where
  fromAvro (T.Int  v) = pure $ microsToDiffTime (toInteger v)
  fromAvro (T.Long v) = pure $ microsToDiffTime (toInteger v)
  fromAvro v = badValue v "TimeMicros"

instance FromAvro a => FromAvro (Maybe a) where
  fromAvro (T.Union ts _ v) = case (V.toList ts, v) of
    ([S.Null, _], T.Null) -> pure Nothing
    ([S.Null, _], v')     -> Just <$> fromAvro v'
    _                     -> badValue v "Maybe a"
  fromAvro v                = badValue v "Maybe a"

instance FromAvro a => FromAvro [a] where
  fromAvro (T.Array vec) = mapM fromAvro $ toList vec
  fromAvro v             = badValue v "[a]"

instance FromAvro a => FromAvro (V.Vector a) where
  fromAvro (T.Array vec) = mapM fromAvro vec
  fromAvro v             = badValue v "Vector a"

instance (U.Unbox a, FromAvro a) => FromAvro (U.Vector a) where
  fromAvro (T.Array vec) = U.convert <$> mapM fromAvro vec
  fromAvro v             = badValue v "Unboxed Vector a"

instance FromAvro Text where
  fromAvro (T.String txt) = pure txt
  fromAvro v              = badValue v "Text"

instance FromAvro TL.Text where
  fromAvro (T.String txt) = pure (TL.fromStrict txt)
  fromAvro v              = badValue v "Lazy Text"

instance (FromAvro a) => FromAvro (Map.Map Text a) where
  fromAvro (T.Record _ mp) = mapM fromAvro $ Map.fromList (HashMap.toList mp)
  fromAvro (T.Map mp)      = mapM fromAvro $ Map.fromList (HashMap.toList mp)
  fromAvro v               = badValue v "Map Text a"

instance (FromAvro a) => FromAvro (HashMap.HashMap Text a) where
  fromAvro (T.Record _ mp) = mapM fromAvro mp
  fromAvro (T.Map mp)      = mapM fromAvro mp
  fromAvro v               = badValue v "HashMap Text a"