{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
module Database.Relational.Pure () where
import Control.Applicative (pure)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word8, Word16, Word32, Word64, Word)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Text.Printf (PrintfArg, printf)
import Data.Time (Day, TimeOfDay, LocalTime)
import Data.DList (DList, fromList)
import Language.SQL.Keyword (Keyword (..))
import Database.Record
(PersistableWidth, persistableWidth, PersistableRecordWidth)
import Database.Record.Persistable
(runPersistableRecordWidth)
import Database.Relational.Internal.String (StringSQL, stringSQL)
import qualified Database.Relational.Internal.Literal as Lit
import Database.Relational.ProjectableClass (LiteralSQL (..))
instance LiteralSQL ()
instance LiteralSQL Int8 where
showLiteral' :: Int8 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Int8 -> StringSQL) -> Int8 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Int16 where
showLiteral' :: Int16 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Int16 -> StringSQL) -> Int16 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Int32 where
showLiteral' :: Int32 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Int32 -> StringSQL) -> Int32 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Int64 where
showLiteral' :: Int64 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Int64 -> StringSQL) -> Int64 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Int where
showLiteral' :: Int -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Int -> StringSQL) -> Int -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Word8 where
showLiteral' :: Word8 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Word8 -> StringSQL) -> Word8 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Word16 where
showLiteral' :: Word16 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Word16 -> StringSQL) -> Word16 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Word32 where
showLiteral' :: Word32 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Word32 -> StringSQL) -> Word32 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Word64 where
showLiteral' :: Word64 -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Word64 -> StringSQL) -> Word64 -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Word where
showLiteral' :: Word -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Word -> StringSQL) -> Word -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL Integer where
showLiteral' :: Integer -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Integer -> StringSQL) -> Integer -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> StringSQL
forall a. (Show a, Integral a) => a -> StringSQL
Lit.integral
instance LiteralSQL String where
showLiteral' :: String -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (String -> StringSQL) -> String -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringSQL
Lit.stringExpr
instance LiteralSQL Text where
showLiteral' :: Text -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Text -> StringSQL) -> Text -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringSQL
Lit.stringExpr (String -> StringSQL) -> (Text -> String) -> Text -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance LiteralSQL LT.Text where
showLiteral' :: Text -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Text -> StringSQL) -> Text -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringSQL
Lit.stringExpr (String -> StringSQL) -> (Text -> String) -> Text -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack
instance LiteralSQL Char where
showLiteral' :: Char -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Char -> StringSQL) -> Char -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringSQL
Lit.stringExpr (String -> StringSQL) -> (Char -> String) -> Char -> StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:String
"")
instance LiteralSQL Bool where
showLiteral' :: Bool -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Bool -> StringSQL) -> Bool -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> StringSQL
Lit.bool
floatTerms :: (PrintfArg a, Ord a, Num a)=> a -> DList StringSQL
floatTerms :: a -> DList StringSQL
floatTerms a
f = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (String -> StringSQL) -> String -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StringSQL
stringSQL (String -> DList StringSQL) -> String -> DList StringSQL
forall a b. (a -> b) -> a -> b
$ String -> a -> String
forall r. PrintfType r => String -> r
printf String
fmt a
f where
fmt :: String
fmt
| a
f a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = String
"%f"
| Bool
otherwise = String
"(%f)"
instance LiteralSQL Float where
showLiteral' :: Float -> DList StringSQL
showLiteral' = Float -> DList StringSQL
forall a. (PrintfArg a, Ord a, Num a) => a -> DList StringSQL
floatTerms
instance LiteralSQL Double where
showLiteral' :: Double -> DList StringSQL
showLiteral' = Double -> DList StringSQL
forall a. (PrintfArg a, Ord a, Num a) => a -> DList StringSQL
floatTerms
instance LiteralSQL Day where
showLiteral' :: Day -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (Day -> StringSQL) -> Day -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringSQL -> String -> Day -> StringSQL
forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
Lit.timestamp StringSQL
DATE String
"%Y-%m-%d"
instance LiteralSQL TimeOfDay where
showLiteral' :: TimeOfDay -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (TimeOfDay -> StringSQL) -> TimeOfDay -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringSQL -> String -> TimeOfDay -> StringSQL
forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
Lit.timestamp StringSQL
TIME String
"%H:%M:%S"
instance LiteralSQL LocalTime where
showLiteral' :: LocalTime -> DList StringSQL
showLiteral' = StringSQL -> DList StringSQL
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StringSQL -> DList StringSQL)
-> (LocalTime -> StringSQL) -> LocalTime -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringSQL -> String -> LocalTime -> StringSQL
forall t. FormatTime t => StringSQL -> String -> t -> StringSQL
Lit.timestamp StringSQL
TIMESTAMP String
"%Y-%m-%d %H:%M:%S"
showMaybeTerms :: LiteralSQL a => PersistableRecordWidth a -> Maybe a -> DList StringSQL
showMaybeTerms :: PersistableRecordWidth a -> Maybe a -> DList StringSQL
showMaybeTerms PersistableRecordWidth a
wa = Maybe a -> DList StringSQL
forall a. LiteralSQL a => Maybe a -> DList StringSQL
d where
d :: Maybe a -> DList StringSQL
d (Just a
a) = a -> DList StringSQL
forall a. LiteralSQL a => a -> DList StringSQL
showLiteral' a
a
d Maybe a
Nothing = [StringSQL] -> DList StringSQL
forall a. [a] -> DList a
fromList ([StringSQL] -> DList StringSQL)
-> (StringSQL -> [StringSQL]) -> StringSQL -> DList StringSQL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StringSQL -> [StringSQL]
forall a. Int -> a -> [a]
replicate (PersistableRecordWidth a -> Int
forall a. PersistableRecordWidth a -> Int
runPersistableRecordWidth PersistableRecordWidth a
wa) (StringSQL -> DList StringSQL) -> StringSQL -> DList StringSQL
forall a b. (a -> b) -> a -> b
$ String -> StringSQL
stringSQL String
"NULL"
instance (PersistableWidth a, LiteralSQL a)
=> LiteralSQL (Maybe a) where
showLiteral' :: Maybe a -> DList StringSQL
showLiteral' = PersistableRecordWidth a -> Maybe a -> DList StringSQL
forall a.
LiteralSQL a =>
PersistableRecordWidth a -> Maybe a -> DList StringSQL
showMaybeTerms PersistableRecordWidth a
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth