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)