module Sqel.ResultShape where

import Data.Vector (Vector)
import Hasql.Decoders (Result, Row, noResult, rowList, rowMaybe, rowVector, singleRow)

class ResultShape d r | r -> d where
  resultShape :: Row d -> Result r

instance ResultShape d (Vector d) where
  resultShape :: Row d -> Result (Vector d)
resultShape =
    forall d. Row d -> Result (Vector d)
rowVector

instance ResultShape d [d] where
  resultShape :: Row d -> Result [d]
resultShape =
    forall d. Row d -> Result [d]
rowList

instance ResultShape d (Maybe d) where
  resultShape :: Row d -> Result (Maybe d)
resultShape =
    forall d. Row d -> Result (Maybe d)
rowMaybe

instance ResultShape () () where
  resultShape :: Row () -> Result ()
resultShape =
    forall a b. a -> b -> a
const Result ()
noResult

instance ResultShape a (Identity a) where
  resultShape :: Row a -> Result (Identity a)
resultShape =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Row a -> Result a
singleRow