{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}

-- |
-- Module      : Database.Record.FromSql
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines interfaces
-- from list of database value type into Haskell type.

module Database.Record.FromSql (
  -- * Conversion from list of database value type into record type
  RecordFromSql, runTakeRecord, runToRecord,
  createRecordFromSql,

  (<&>),
  maybeRecord,

  -- * Derivation rules of 'RecordFromSql' conversion
  FromSql (recordFromSql),
  takeRecord, toRecord,

  valueRecordFromSql,
  ) where

import GHC.Generics (Generic, Rep, U1 (..), K1 (..), M1 (..), (:*:)(..), to)
import Control.Applicative ((<$>), Applicative (pure, (<*>)))
import Control.Monad (liftM, ap)

import Database.Record.Persistable (PersistableType)
import qualified Database.Record.Persistable as Persistable
import Database.Record.KeyConstraint
  (HasColumnConstraint(columnConstraint), ColumnConstraint, NotNull, index)

{- |
'RecordFromSql' 'q' 'a' is data-type wrapping function
to convert from list of database value type (to receive from database) ['q'] into Haskell type 'a'

This structure is similar to parser.
While running 'RecordFromSql' behavior is the same as non-fail-able parser
which parse list of database value type ['q'] stream.

So, 'RecordFromSql' 'q' is 'Monad' and 'Applicative' instance like parser monad.
When, you have data constructor and objects like below.

@
  data MyRecord = MyRecord Foo Bar Baz
@

@
  foo :: 'RecordFromSql' SqlValue Foo
  foo =  ...
  bar :: 'RecordFromSql' SqlValue Bar
  bar =  ...
  baz :: 'RecordFromSql' SqlValue Baz
  baz =  ...
@

You can get composed 'RecordFromSql' like below.

@
  myRecord :: RecordFromSql SqlValue MyRecord
  myRecord =  MyRecord \<$\> foo \<*\> bar \<*\> baz
@
-}
newtype RecordFromSql q a = RecordFromSql ([q] -> (a, [q]))

-- | Run 'RecordFromSql' parser function object.
--   Convert from list of database value type ['q'] into Haskell type 'a' and rest of list ['q'].
runTakeRecord :: RecordFromSql q a -- ^ parser function object which has capability to convert
              -> [q]               -- ^ list of database value type
              -> (a, [q])          -- ^ Haskell type and rest of list
runTakeRecord :: forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord (RecordFromSql [q] -> (a, [q])
f) = [q] -> (a, [q])
f

-- | Axiom of 'RecordFromSql' for database value type 'q' and Haskell type 'a'
createRecordFromSql :: ([q] -> (a, [q])) -- ^ Convert function body
                    -> RecordFromSql q a -- ^ Result parser function object
createRecordFromSql :: forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql =  forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
RecordFromSql

-- | Run 'RecordFromSql' parser function object. Convert from list of database value type ['q'] into  Haskell type 'a'.
runToRecord :: RecordFromSql q a -- ^ parser function object which has capability to convert
            -> [q]               -- ^ list of database value type
            -> a                 -- ^ Haskell type
runToRecord :: forall q a. RecordFromSql q a -> [q] -> a
runToRecord RecordFromSql q a
r = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord RecordFromSql q a
r

-- | 'Monad' instance like parser 'Monad'.
instance Monad (RecordFromSql q) where
  return :: forall a. a -> RecordFromSql q a
return a
a = forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql ((,) a
a)
  RecordFromSql q a
ma >>= :: forall a b.
RecordFromSql q a -> (a -> RecordFromSql q b) -> RecordFromSql q b
>>= a -> RecordFromSql q b
fmb =
    forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql
    (\[q]
vals -> let (a
a, [q]
vals') = forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord RecordFromSql q a
ma [q]
vals
              in  forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord (a -> RecordFromSql q b
fmb a
a) [q]
vals')

-- | Derived 'Functor' instance from 'Monad' instance
instance Functor (RecordFromSql q) where
  fmap :: forall a b. (a -> b) -> RecordFromSql q a -> RecordFromSql q b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

-- | Derived 'Applicative' instance from 'Monad' instance
instance Applicative (RecordFromSql q) where
  pure :: forall a. a -> RecordFromSql q a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b.
RecordFromSql q (a -> b) -> RecordFromSql q a -> RecordFromSql q b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

-- | Derivation rule of 'RecordFromSql' parser function object for Haskell tuple (,) type.
(<&>) :: RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q (a, b)
RecordFromSql q a
a <&> :: forall q a b.
RecordFromSql q a -> RecordFromSql q b -> RecordFromSql q (a, b)
<&> RecordFromSql q b
b = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RecordFromSql q a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RecordFromSql q b
b

infixl 4 <&>


-- | Derivation rule of 'RecordFromSql' parser function object for Haskell 'Maybe' type.
maybeRecord :: PersistableType q
            => RecordFromSql q a
            -> ColumnConstraint NotNull a
            -> RecordFromSql q (Maybe a)
maybeRecord :: forall q a.
PersistableType q =>
RecordFromSql q a
-> ColumnConstraint NotNull a -> RecordFromSql q (Maybe a)
maybeRecord RecordFromSql q a
rec ColumnConstraint NotNull a
pkey = forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql [q] -> (Maybe a, [q])
mayToRec where
  mayToRec :: [q] -> (Maybe a, [q])
mayToRec [q]
vals
    | [q]
vals forall a. [a] -> Int -> a
!! forall c r. ColumnConstraint c r -> Int
index ColumnConstraint NotNull a
pkey forall a. Eq a => a -> a -> Bool
/= forall q. PersistableType q => q
Persistable.sqlNullValue = (forall a. a -> Maybe a
Just a
a,  [q]
vals')
    | Bool
otherwise                         = (forall a. Maybe a
Nothing, [q]
vals')  where
      (a
a, [q]
vals') = forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord RecordFromSql q a
rec [q]
vals

{- |
'FromSql' 'q' 'a' is implicit rule to derive 'RecordFromSql' 'q' 'a' record parser function against type 'a'.

Generic programming (<https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming>)
with default signature is available for 'FromSql' class,
so you can make instance like below:

@
  \{\-\# LANGUAGE DeriveGeneric \#\-\}
  import GHC.Generics (Generic)
  import Database.HDBC (SqlValue)
  --
  data Foo = Foo { ... } deriving Generic
  instance FromSql SqlValue Foo
@

-}
class FromSql q a where
  -- | 'RecordFromSql' 'q' 'a' record parser function.
  recordFromSql :: RecordFromSql q a

  default recordFromSql :: (Generic a, GFromSql q (Rep a)) => RecordFromSql q a
  recordFromSql = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q (f :: * -> *) a. GFromSql q f => RecordFromSql q (f a)
gFromSql


class GFromSql q f where
  gFromSql :: RecordFromSql q (f a)

instance GFromSql q U1 where
  gFromSql :: forall a. RecordFromSql q (U1 a)
gFromSql = forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql forall a b. (a -> b) -> a -> b
$ (,) forall k (p :: k). U1 p
U1

instance (GFromSql q a, GFromSql q b) => GFromSql q (a :*: b) where
  gFromSql :: forall a. RecordFromSql q ((:*:) a b a)
gFromSql = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q (f :: * -> *) a. GFromSql q f => RecordFromSql q (f a)
gFromSql forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall q (f :: * -> *) a. GFromSql q f => RecordFromSql q (f a)
gFromSql

instance GFromSql q a => GFromSql q (M1 i c a) where
  gFromSql :: forall a. RecordFromSql q (M1 i c a a)
gFromSql = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q (f :: * -> *) a. GFromSql q f => RecordFromSql q (f a)
gFromSql

instance FromSql q a => GFromSql q (K1 i a) where
  gFromSql :: forall a. RecordFromSql q (K1 i a a)
gFromSql = forall k i c (p :: k). c -> K1 i c p
K1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall q a. FromSql q a => RecordFromSql q a
recordFromSql


-- | Implicit derivation rule of 'RecordFromSql' parser function object which can convert
--   from list of database value type ['q'] into Haskell 'Maybe' type.
instance (HasColumnConstraint NotNull a, FromSql q a, PersistableType q)
         => FromSql q (Maybe a)  where
  recordFromSql :: RecordFromSql q (Maybe a)
recordFromSql = forall q a.
PersistableType q =>
RecordFromSql q a
-> ColumnConstraint NotNull a -> RecordFromSql q (Maybe a)
maybeRecord forall q a. FromSql q a => RecordFromSql q a
recordFromSql forall c a. HasColumnConstraint c a => ColumnConstraint c a
columnConstraint

-- | Implicit derivation rule of 'RecordFromSql' parser function object which can convert
--   from /empty/ list of database value type ['q'] into Haskell unit () type.
instance FromSql q ()  -- default generic instance

-- | Run implicit 'RecordFromSql' parser function object.
--   Convert from list of database value type ['q'] into haskell type 'a' and rest of list ['q'].
takeRecord :: FromSql q a => [q] -> (a, [q])
takeRecord :: forall q a. FromSql q a => [q] -> (a, [q])
takeRecord =  forall q a. RecordFromSql q a -> [q] -> (a, [q])
runTakeRecord forall q a. FromSql q a => RecordFromSql q a
recordFromSql

-- | Run implicit 'RecordFromSql' parser function object.
--   Convert from list of database value type ['q'] into haskell type 'a'.
toRecord :: FromSql q a => [q] -> a
toRecord :: forall q a. FromSql q a => [q] -> a
toRecord =  forall q a. RecordFromSql q a -> [q] -> a
runToRecord forall q a. FromSql q a => RecordFromSql q a
recordFromSql

-- | Derivation rule of 'RecordFromSql' parser function object for value convert function.
valueRecordFromSql :: (q -> a) -> RecordFromSql q a
valueRecordFromSql :: forall q a. (q -> a) -> RecordFromSql q a
valueRecordFromSql q -> a
d = forall q a. ([q] -> (a, [q])) -> RecordFromSql q a
createRecordFromSql forall a b. (a -> b) -> a -> b
$ \[q]
qs -> (q -> a
d forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [q]
qs, forall a. [a] -> [a]
tail [q]
qs)