{-# LANGUAGE DeriveDataTypeable, CPP #-}
module Database.SQLite.Simple.Types
(
Null(..)
, Only(..)
, Query(..)
, (:.)(..)
) where
import Control.Arrow (first)
import Data.String (IsString(..))
import Data.Tuple.Only (Only(..))
import Data.Typeable (Typeable)
import qualified Data.Text as T
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
data Null = Null
deriving (ReadPrec [Null]
ReadPrec Null
Int -> ReadS Null
ReadS [Null]
(Int -> ReadS Null)
-> ReadS [Null] -> ReadPrec Null -> ReadPrec [Null] -> Read Null
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Null
readsPrec :: Int -> ReadS Null
$creadList :: ReadS [Null]
readList :: ReadS [Null]
$creadPrec :: ReadPrec Null
readPrec :: ReadPrec Null
$creadListPrec :: ReadPrec [Null]
readListPrec :: ReadPrec [Null]
Read, Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
(Int -> Null -> ShowS)
-> (Null -> String) -> ([Null] -> ShowS) -> Show Null
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Null -> ShowS
showsPrec :: Int -> Null -> ShowS
$cshow :: Null -> String
show :: Null -> String
$cshowList :: [Null] -> ShowS
showList :: [Null] -> ShowS
Show, Typeable)
instance Eq Null where
Null
_ == :: Null -> Null -> Bool
== Null
_ = Bool
False
Null
_ /= :: Null -> Null -> Bool
/= Null
_ = Bool
False
newtype Query = Query {
Query -> Text
fromQuery :: T.Text
} deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
/= :: Query -> Query -> Bool
Eq, Eq Query
Eq Query =>
(Query -> Query -> Ordering)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Bool)
-> (Query -> Query -> Query)
-> (Query -> Query -> Query)
-> Ord Query
Query -> Query -> Bool
Query -> Query -> Ordering
Query -> Query -> Query
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Query -> Query -> Ordering
compare :: Query -> Query -> Ordering
$c< :: Query -> Query -> Bool
< :: Query -> Query -> Bool
$c<= :: Query -> Query -> Bool
<= :: Query -> Query -> Bool
$c> :: Query -> Query -> Bool
> :: Query -> Query -> Bool
$c>= :: Query -> Query -> Bool
>= :: Query -> Query -> Bool
$cmax :: Query -> Query -> Query
max :: Query -> Query -> Query
$cmin :: Query -> Query -> Query
min :: Query -> Query -> Query
Ord, Typeable)
instance Show Query where
show :: Query -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Query -> Text) -> Query -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Text
fromQuery
instance Read Query where
readsPrec :: Int -> ReadS Query
readsPrec Int
i = ((Text, String) -> (Query, String))
-> [(Text, String)] -> [(Query, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Query) -> (Text, String) -> (Query, String)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> Query
Query) ([(Text, String)] -> [(Query, String)])
-> (String -> [(Text, String)]) -> ReadS Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Text, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance IsString Query where
fromString :: String -> Query
fromString = Text -> Query
Query (Text -> Query) -> (String -> Text) -> String -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance Semigroup Query where
Query Text
a <> :: Query -> Query -> Query
<> Query Text
b = Text -> Query
Query (Text -> Text -> Text
T.append Text
a Text
b)
{-# INLINE (<>) #-}
instance Monoid Query where
mempty :: Query
mempty = Text -> Query
Query Text
T.empty
mappend :: Query -> Query -> Query
mappend = Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
data h :. t = h :. t deriving ((h :. t) -> (h :. t) -> Bool
((h :. t) -> (h :. t) -> Bool)
-> ((h :. t) -> (h :. t) -> Bool) -> Eq (h :. t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall h t. (Eq h, Eq t) => (h :. t) -> (h :. t) -> Bool
$c== :: forall h t. (Eq h, Eq t) => (h :. t) -> (h :. t) -> Bool
== :: (h :. t) -> (h :. t) -> Bool
$c/= :: forall h t. (Eq h, Eq t) => (h :. t) -> (h :. t) -> Bool
/= :: (h :. t) -> (h :. t) -> Bool
Eq,Eq (h :. t)
Eq (h :. t) =>
((h :. t) -> (h :. t) -> Ordering)
-> ((h :. t) -> (h :. t) -> Bool)
-> ((h :. t) -> (h :. t) -> Bool)
-> ((h :. t) -> (h :. t) -> Bool)
-> ((h :. t) -> (h :. t) -> Bool)
-> ((h :. t) -> (h :. t) -> h :. t)
-> ((h :. t) -> (h :. t) -> h :. t)
-> Ord (h :. t)
(h :. t) -> (h :. t) -> Bool
(h :. t) -> (h :. t) -> Ordering
(h :. t) -> (h :. t) -> h :. t
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall h t. (Ord h, Ord t) => Eq (h :. t)
forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Bool
forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Ordering
forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> h :. t
$ccompare :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Ordering
compare :: (h :. t) -> (h :. t) -> Ordering
$c< :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Bool
< :: (h :. t) -> (h :. t) -> Bool
$c<= :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Bool
<= :: (h :. t) -> (h :. t) -> Bool
$c> :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Bool
> :: (h :. t) -> (h :. t) -> Bool
$c>= :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> Bool
>= :: (h :. t) -> (h :. t) -> Bool
$cmax :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> h :. t
max :: (h :. t) -> (h :. t) -> h :. t
$cmin :: forall h t. (Ord h, Ord t) => (h :. t) -> (h :. t) -> h :. t
min :: (h :. t) -> (h :. t) -> h :. t
Ord,Int -> (h :. t) -> ShowS
[h :. t] -> ShowS
(h :. t) -> String
(Int -> (h :. t) -> ShowS)
-> ((h :. t) -> String) -> ([h :. t] -> ShowS) -> Show (h :. t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall h t. (Show h, Show t) => Int -> (h :. t) -> ShowS
forall h t. (Show h, Show t) => [h :. t] -> ShowS
forall h t. (Show h, Show t) => (h :. t) -> String
$cshowsPrec :: forall h t. (Show h, Show t) => Int -> (h :. t) -> ShowS
showsPrec :: Int -> (h :. t) -> ShowS
$cshow :: forall h t. (Show h, Show t) => (h :. t) -> String
show :: (h :. t) -> String
$cshowList :: forall h t. (Show h, Show t) => [h :. t] -> ShowS
showList :: [h :. t] -> ShowS
Show,ReadPrec [h :. t]
ReadPrec (h :. t)
Int -> ReadS (h :. t)
ReadS [h :. t]
(Int -> ReadS (h :. t))
-> ReadS [h :. t]
-> ReadPrec (h :. t)
-> ReadPrec [h :. t]
-> Read (h :. t)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall h t. (Read h, Read t) => ReadPrec [h :. t]
forall h t. (Read h, Read t) => ReadPrec (h :. t)
forall h t. (Read h, Read t) => Int -> ReadS (h :. t)
forall h t. (Read h, Read t) => ReadS [h :. t]
$creadsPrec :: forall h t. (Read h, Read t) => Int -> ReadS (h :. t)
readsPrec :: Int -> ReadS (h :. t)
$creadList :: forall h t. (Read h, Read t) => ReadS [h :. t]
readList :: ReadS [h :. t]
$creadPrec :: forall h t. (Read h, Read t) => ReadPrec (h :. t)
readPrec :: ReadPrec (h :. t)
$creadListPrec :: forall h t. (Read h, Read t) => ReadPrec [h :. t]
readListPrec :: ReadPrec [h :. t]
Read,Typeable)
infixr 3 :.