module Sqel.Codec.PrimDecoder where import qualified Chronos as Chronos import qualified Data.Map.Strict as Map import Data.Scientific (Scientific) import qualified Data.Set as Set import Data.Time (Day, DiffTime, LocalTime (LocalTime), TimeOfDay (TimeOfDay), TimeZone, UTCTime, toModifiedJulianDay) import Data.UUID (UUID) import Data.Vector (Vector) import Hasql.Decoders ( Value, bool, bytea, char, custom, date, enum, float4, float8, int2, int4, int8, interval, listArray, nonNullable, numeric, refine, text, time, timestamp, timestamptz, timetz, uuid, vectorArray, ) import Path (Abs, Dir, File, Path, Rel, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile) import Prelude hiding (Enum, bool) import Sqel.SOP.Enum (EnumTable (enumTable)) class PrimDecoder a where primDecoder :: Value a instance PrimDecoder () where primDecoder :: Value () primDecoder = forall (f :: * -> *) a. Functor f => f a -> f () void Value Bool bool instance PrimDecoder Bool where primDecoder :: Value Bool primDecoder = Value Bool bool instance PrimDecoder Int16 where primDecoder :: Value Int16 primDecoder = Value Int16 int2 instance PrimDecoder Int32 where primDecoder :: Value Int32 primDecoder = Value Int32 int4 instance PrimDecoder Int64 where primDecoder :: Value Int64 primDecoder = Value Int64 int8 instance PrimDecoder Int where primDecoder :: Value Int primDecoder = forall a b. (Integral a, Num b) => a -> b fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value Int64 int8 instance PrimDecoder Float where primDecoder :: Value Float primDecoder = Value Float float4 instance PrimDecoder Double where primDecoder :: Value Double primDecoder = Value Double float8 instance PrimDecoder Scientific where primDecoder :: Value Scientific primDecoder = Value Scientific numeric instance PrimDecoder Char where primDecoder :: Value Char primDecoder = Value Char char instance PrimDecoder Text where primDecoder :: Value Text primDecoder = Value Text text instance PrimDecoder ByteString where primDecoder :: Value ByteString primDecoder = Value ByteString bytea instance PrimDecoder Day where primDecoder :: Value Day primDecoder = Value Day date instance PrimDecoder LocalTime where primDecoder :: Value LocalTime primDecoder = Value LocalTime timestamp instance PrimDecoder UTCTime where primDecoder :: Value UTCTime primDecoder = Value UTCTime timestamptz instance PrimDecoder TimeOfDay where primDecoder :: Value TimeOfDay primDecoder = Value TimeOfDay time instance PrimDecoder (TimeOfDay, TimeZone) where primDecoder :: Value (TimeOfDay, TimeZone) primDecoder = Value (TimeOfDay, TimeZone) timetz instance PrimDecoder DiffTime where primDecoder :: Value DiffTime primDecoder = Value DiffTime interval instance PrimDecoder UUID where primDecoder :: Value UUID primDecoder = Value UUID uuid decodePath :: Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath :: forall e b t. Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath String -> Either e (Path b t) parse Bool _ = forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first forall b a. (Show a, IsString b) => a -> b show forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Either e (Path b t) parse forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. ConvertUtf8 a b => b -> a decodeUtf8 instance PrimDecoder (Path Abs File) where primDecoder :: Value (Path Abs File) primDecoder = forall a. (Bool -> ByteString -> Either Text a) -> Value a custom (forall e b t. Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File) parseAbsFile) instance PrimDecoder (Path Abs Dir) where primDecoder :: Value (Path Abs Dir) primDecoder = forall a. (Bool -> ByteString -> Either Text a) -> Value a custom (forall e b t. Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir) parseAbsDir) instance PrimDecoder (Path Rel File) where primDecoder :: Value (Path Rel File) primDecoder = forall a. (Bool -> ByteString -> Either Text a) -> Value a custom (forall e b t. Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File) parseRelFile) instance PrimDecoder (Path Rel Dir) where primDecoder :: Value (Path Rel Dir) primDecoder = forall a. (Bool -> ByteString -> Either Text a) -> Value a custom (forall e b t. Show e => (String -> Either e (Path b t)) -> Bool -> ByteString -> Either Text (Path b t) decodePath forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir) parseRelDir) dayToChronos :: Day -> Chronos.Date dayToChronos :: Day -> Date dayToChronos = Day -> Date Chronos.dayToDate forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Day Chronos.Day forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (Integral a, Num b) => a -> b fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c . Day -> Integer toModifiedJulianDay instance PrimDecoder Chronos.Date where primDecoder :: Value Date primDecoder = Day -> Date dayToChronos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value Day date instance PrimDecoder Chronos.Time where primDecoder :: Value Time primDecoder = Int64 -> Time Chronos.Time forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Value Int64 int8 chronosToTimeOfDay :: TimeOfDay -> Chronos.TimeOfDay chronosToTimeOfDay :: TimeOfDay -> TimeOfDay chronosToTimeOfDay (TimeOfDay Int h Int m Pico ns) = Int -> Int -> Int64 -> TimeOfDay Chronos.TimeOfDay Int h Int m (forall a b. (RealFrac a, Integral b) => a -> b round (Pico ns forall a. Num a => a -> a -> a * Pico 1000000000)) localTimeToDatetime :: LocalTime -> Chronos.Datetime localTimeToDatetime :: LocalTime -> Datetime localTimeToDatetime (LocalTime Day d TimeOfDay t) = Date -> TimeOfDay -> Datetime Chronos.Datetime (Day -> Date dayToChronos Day d) (TimeOfDay -> TimeOfDay chronosToTimeOfDay TimeOfDay t) instance PrimDecoder Chronos.Datetime where primDecoder :: Value Datetime primDecoder = LocalTime -> Datetime localTimeToDatetime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. PrimDecoder a => Value a primDecoder class ArrayDecoder f a where arrayDecoder :: Value a -> Value (f a) instance ArrayDecoder [] a where arrayDecoder :: Value a -> Value [a] arrayDecoder = forall element. NullableOrNot Value element -> Value [element] listArray forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a nonNullable instance ArrayDecoder NonEmpty a where arrayDecoder :: Value a -> Value (NonEmpty a) arrayDecoder = forall a b. (a -> Either Text b) -> Value a -> Value b refine (forall l r. l -> Maybe r -> Either l r maybeToRight Text "no elements in NonEmpty field" forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> Maybe (NonEmpty a) nonEmpty) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall element. NullableOrNot Value element -> Value [element] listArray forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a nonNullable instance ArrayDecoder Vector a where arrayDecoder :: Value a -> Value (Vector a) arrayDecoder = forall (vector :: * -> *) element. Vector vector element => NullableOrNot Value element -> Value (vector element) vectorArray forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a nonNullable instance ( Ord a ) => ArrayDecoder Set a where arrayDecoder :: Value a -> Value (Set a) arrayDecoder = forall a b. (a -> Either Text b) -> Value a -> Value b refine (forall a b. b -> Either a b Right forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Ord a => [a] -> Set a Set.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall element. NullableOrNot Value element -> Value [element] listArray forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (decoder :: * -> *) a. decoder a -> NullableOrNot decoder a nonNullable enumDecoder :: EnumTable a => Value a enumDecoder :: forall a. EnumTable a => Value a enumDecoder = forall a. (Text -> Maybe a) -> Value a enum (forall k a. Ord k => k -> Map k a -> Maybe a `Map.lookup` forall a. EnumTable a => Map Text a enumTable) readDecoder :: Read a => Value a readDecoder :: forall a. Read a => Value a readDecoder = forall a. (Text -> Maybe a) -> Value a enum (forall a. Read a => String -> Maybe a readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. IsString a => Text -> a fromText)