{-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}

module HsDev.Database.SQLite.Select (
	Select(..), select_, from_, where_, buildQuery, toQuery,
	qSymbolId, qSymbol, qModuleLocation, qModuleId, qImport, qBuildInfo,
	qNSymbol, qNote
	) where

import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Data.Semigroup
import Database.SQLite.Simple
import Text.Format

data Select a = Select {
	Select a -> [a]
selectColumns :: [a],
	Select a -> [a]
selectTables :: [a],
	Select a -> [a]
selectConditions :: [a] }
		deriving (Select a -> Select a -> Bool
(Select a -> Select a -> Bool)
-> (Select a -> Select a -> Bool) -> Eq (Select a)
forall a. Eq a => Select a -> Select a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Select a -> Select a -> Bool
$c/= :: forall a. Eq a => Select a -> Select a -> Bool
== :: Select a -> Select a -> Bool
$c== :: forall a. Eq a => Select a -> Select a -> Bool
Eq, Eq (Select a)
Eq (Select a)
-> (Select a -> Select a -> Ordering)
-> (Select a -> Select a -> Bool)
-> (Select a -> Select a -> Bool)
-> (Select a -> Select a -> Bool)
-> (Select a -> Select a -> Bool)
-> (Select a -> Select a -> Select a)
-> (Select a -> Select a -> Select a)
-> Ord (Select a)
Select a -> Select a -> Bool
Select a -> Select a -> Ordering
Select a -> Select a -> Select a
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 a. Ord a => Eq (Select a)
forall a. Ord a => Select a -> Select a -> Bool
forall a. Ord a => Select a -> Select a -> Ordering
forall a. Ord a => Select a -> Select a -> Select a
min :: Select a -> Select a -> Select a
$cmin :: forall a. Ord a => Select a -> Select a -> Select a
max :: Select a -> Select a -> Select a
$cmax :: forall a. Ord a => Select a -> Select a -> Select a
>= :: Select a -> Select a -> Bool
$c>= :: forall a. Ord a => Select a -> Select a -> Bool
> :: Select a -> Select a -> Bool
$c> :: forall a. Ord a => Select a -> Select a -> Bool
<= :: Select a -> Select a -> Bool
$c<= :: forall a. Ord a => Select a -> Select a -> Bool
< :: Select a -> Select a -> Bool
$c< :: forall a. Ord a => Select a -> Select a -> Bool
compare :: Select a -> Select a -> Ordering
$ccompare :: forall a. Ord a => Select a -> Select a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Select a)
Ord, ReadPrec [Select a]
ReadPrec (Select a)
Int -> ReadS (Select a)
ReadS [Select a]
(Int -> ReadS (Select a))
-> ReadS [Select a]
-> ReadPrec (Select a)
-> ReadPrec [Select a]
-> Read (Select a)
forall a. Read a => ReadPrec [Select a]
forall a. Read a => ReadPrec (Select a)
forall a. Read a => Int -> ReadS (Select a)
forall a. Read a => ReadS [Select a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Select a]
$creadListPrec :: forall a. Read a => ReadPrec [Select a]
readPrec :: ReadPrec (Select a)
$creadPrec :: forall a. Read a => ReadPrec (Select a)
readList :: ReadS [Select a]
$creadList :: forall a. Read a => ReadS [Select a]
readsPrec :: Int -> ReadS (Select a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Select a)
Read, Int -> Select a -> ShowS
[Select a] -> ShowS
Select a -> String
(Int -> Select a -> ShowS)
-> (Select a -> String) -> ([Select a] -> ShowS) -> Show (Select a)
forall a. Show a => Int -> Select a -> ShowS
forall a. Show a => [Select a] -> ShowS
forall a. Show a => Select a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Select a] -> ShowS
$cshowList :: forall a. Show a => [Select a] -> ShowS
show :: Select a -> String
$cshow :: forall a. Show a => Select a -> String
showsPrec :: Int -> Select a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Select a -> ShowS
Show, a -> Select b -> Select a
(a -> b) -> Select a -> Select b
(forall a b. (a -> b) -> Select a -> Select b)
-> (forall a b. a -> Select b -> Select a) -> Functor Select
forall a b. a -> Select b -> Select a
forall a b. (a -> b) -> Select a -> Select b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Select b -> Select a
$c<$ :: forall a b. a -> Select b -> Select a
fmap :: (a -> b) -> Select a -> Select b
$cfmap :: forall a b. (a -> b) -> Select a -> Select b
Functor, Select a -> Bool
(a -> m) -> Select a -> m
(a -> b -> b) -> b -> Select a -> b
(forall m. Monoid m => Select m -> m)
-> (forall m a. Monoid m => (a -> m) -> Select a -> m)
-> (forall m a. Monoid m => (a -> m) -> Select a -> m)
-> (forall a b. (a -> b -> b) -> b -> Select a -> b)
-> (forall a b. (a -> b -> b) -> b -> Select a -> b)
-> (forall b a. (b -> a -> b) -> b -> Select a -> b)
-> (forall b a. (b -> a -> b) -> b -> Select a -> b)
-> (forall a. (a -> a -> a) -> Select a -> a)
-> (forall a. (a -> a -> a) -> Select a -> a)
-> (forall a. Select a -> [a])
-> (forall a. Select a -> Bool)
-> (forall a. Select a -> Int)
-> (forall a. Eq a => a -> Select a -> Bool)
-> (forall a. Ord a => Select a -> a)
-> (forall a. Ord a => Select a -> a)
-> (forall a. Num a => Select a -> a)
-> (forall a. Num a => Select a -> a)
-> Foldable Select
forall a. Eq a => a -> Select a -> Bool
forall a. Num a => Select a -> a
forall a. Ord a => Select a -> a
forall m. Monoid m => Select m -> m
forall a. Select a -> Bool
forall a. Select a -> Int
forall a. Select a -> [a]
forall a. (a -> a -> a) -> Select a -> a
forall m a. Monoid m => (a -> m) -> Select a -> m
forall b a. (b -> a -> b) -> b -> Select a -> b
forall a b. (a -> b -> b) -> b -> Select a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Select a -> a
$cproduct :: forall a. Num a => Select a -> a
sum :: Select a -> a
$csum :: forall a. Num a => Select a -> a
minimum :: Select a -> a
$cminimum :: forall a. Ord a => Select a -> a
maximum :: Select a -> a
$cmaximum :: forall a. Ord a => Select a -> a
elem :: a -> Select a -> Bool
$celem :: forall a. Eq a => a -> Select a -> Bool
length :: Select a -> Int
$clength :: forall a. Select a -> Int
null :: Select a -> Bool
$cnull :: forall a. Select a -> Bool
toList :: Select a -> [a]
$ctoList :: forall a. Select a -> [a]
foldl1 :: (a -> a -> a) -> Select a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Select a -> a
foldr1 :: (a -> a -> a) -> Select a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Select a -> a
foldl' :: (b -> a -> b) -> b -> Select a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Select a -> b
foldl :: (b -> a -> b) -> b -> Select a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Select a -> b
foldr' :: (a -> b -> b) -> b -> Select a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Select a -> b
foldr :: (a -> b -> b) -> b -> Select a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Select a -> b
foldMap' :: (a -> m) -> Select a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Select a -> m
foldMap :: (a -> m) -> Select a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Select a -> m
fold :: Select m -> m
$cfold :: forall m. Monoid m => Select m -> m
Foldable, Functor Select
Foldable Select
Functor Select
-> Foldable Select
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Select a -> f (Select b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Select (f a) -> f (Select a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Select a -> m (Select b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Select (m a) -> m (Select a))
-> Traversable Select
(a -> f b) -> Select a -> f (Select b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Select (m a) -> m (Select a)
forall (f :: * -> *) a.
Applicative f =>
Select (f a) -> f (Select a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Select a -> m (Select b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Select a -> f (Select b)
sequence :: Select (m a) -> m (Select a)
$csequence :: forall (m :: * -> *) a. Monad m => Select (m a) -> m (Select a)
mapM :: (a -> m b) -> Select a -> m (Select b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Select a -> m (Select b)
sequenceA :: Select (f a) -> f (Select a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Select (f a) -> f (Select a)
traverse :: (a -> f b) -> Select a -> f (Select b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Select a -> f (Select b)
$cp2Traversable :: Foldable Select
$cp1Traversable :: Functor Select
Traversable)

instance Semigroup (Select a) where
	Select [a]
lc [a]
lt [a]
lcond <> :: Select a -> Select a -> Select a
<> Select [a]
rc [a]
rt [a]
rcond = [a] -> [a] -> [a] -> Select a
forall a. [a] -> [a] -> [a] -> Select a
Select
		([a]
lc [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
rc)
		([a]
lt [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
rt)
		([a]
lcond [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
rcond)

instance Monoid (Select a) where
	mempty :: Select a
mempty = [a] -> [a] -> [a] -> Select a
forall a. [a] -> [a] -> [a] -> Select a
Select [a]
forall a. Monoid a => a
mempty [a]
forall a. Monoid a => a
mempty [a]
forall a. Monoid a => a
mempty
	mappend :: Select a -> Select a -> Select a
mappend Select a
l Select a
r = Select a
l Select a -> Select a -> Select a
forall a. Semigroup a => a -> a -> a
<> Select a
r

select_ :: [a] -> Select a
select_ :: [a] -> Select a
select_ [a]
cols = [a] -> [a] -> [a] -> Select a
forall a. [a] -> [a] -> [a] -> Select a
Select [a]
cols [] []

from_ :: [a] -> Select a
from_ :: [a] -> Select a
from_ [a]
tbls = [a] -> [a] -> [a] -> Select a
forall a. [a] -> [a] -> [a] -> Select a
Select [] [a]
tbls []

where_ :: [a] -> Select a
where_ :: [a] -> Select a
where_ = [a] -> [a] -> [a] -> Select a
forall a. [a] -> [a] -> [a] -> Select a
Select [] []

buildQuery :: Select Text -> String
buildQuery :: Select Text -> String
buildQuery (Select [Text]
cols [Text]
tables [Text]
conds) = Format
"select {} from {} where {}"
	Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text -> [Text] -> Text
T.intercalate Text
", " [Text]
cols
	Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text -> [Text] -> Text
T.intercalate Text
", " [Text]
tables
	Format -> Text -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text -> [Text] -> Text
T.intercalate Text
" and " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
cond -> [Text] -> Text
T.concat [Text
"(", Text
cond, Text
")"]) [Text]
conds)

toQuery :: Select Text -> Query
toQuery :: Select Text -> Query
toQuery = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query)
-> (Select Text -> String) -> Select Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select Text -> String
buildQuery

qSymbolId :: Select Text
qSymbolId :: Select Text
qSymbolId = [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"s.name",
		Text
"m.name",
		Text
"m.file",
		Text
"m.cabal",
		Text
"m.install_dirs",
		Text
"m.package_name",
		Text
"m.package_version",
		Text
"m.installed_name",
		Text
"m.exposed",
		Text
"m.other_location"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"modules as m", Text
"symbols as s"],
	[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"m.id == s.module_id"]]

qSymbol :: Select Text
qSymbol :: Select Text
qSymbol = [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
	Select Text
qSymbolId,
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"s.docs",
		Text
"s.line",
		Text
"s.column",
		Text
"s.what",
		Text
"s.type",
		Text
"s.parent",
		Text
"s.constructors",
		Text
"s.args",
		Text
"s.context",
		Text
"s.associate",
		Text
"s.pat_type",
		Text
"s.pat_constructor"]]

qModuleLocation :: Text -> Select Text
qModuleLocation :: Text -> Select Text
qModuleLocation Text
ml = [FormatArg] -> [Select Text] -> Select Text
template [String
"ml" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
ml] [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"{ml}.file",
		Text
"{ml}.cabal",
		Text
"{ml}.install_dirs",
		Text
"{ml}.package_name",
		Text
"{ml}.package_version",
		Text
"{ml}.installed_name",
		Text
"{ml}.exposed",
		Text
"{ml}.other_location"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"modules as {ml}"]]

qModuleId :: Select Text
qModuleId :: Select Text
qModuleId = [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"mu.name",
		Text
"mu.file",
		Text
"mu.cabal",
		Text
"mu.install_dirs",
		Text
"mu.package_name",
		Text
"mu.package_version",
		Text
"mu.installed_name",
		Text
"mu.exposed",
		Text
"mu.other_location"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"modules as mu"],
	[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"mu.name is not null"]]

qImport :: Text -> Select Text
qImport :: Text -> Select Text
qImport Text
i = [FormatArg] -> [Select Text] -> Select Text
template [String
"i" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
i] [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"{i}.line", Text
"{i}.column",
		Text
"{i}.module_name",
		Text
"{i}.qualified",
		Text
"{i}.alias"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"imports as {i}"]]

qBuildInfo :: Select Text
qBuildInfo :: Select Text
qBuildInfo = [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"bi.depends",
		Text
"bi.language",
		Text
"bi.extensions",
		Text
"bi.ghc_options",
		Text
"bi.source_dirs",
		Text
"bi.other_modules"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"build_infos as bi"]]

-- | Symbol from haskell-names
qNSymbol :: Text -> Text -> Select Text
qNSymbol :: Text -> Text -> Select Text
qNSymbol Text
m Text
s = [FormatArg] -> [Select Text] -> Select Text
template [String
"m" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
m, String
"s" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
s] [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"{s}.what",
		Text
"{m}.name",
		Text
"{s}.name",
		Text
"{s}.parent",
		Text
"{s}.constructors",
		Text
"{s}.associate",
		Text
"{s}.pat_type",
		Text
"{s}.pat_constructor"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"symbols as {s}", Text
"modules as {m}"],
	[Text] -> Select Text
forall a. [a] -> Select a
where_ [Text
"{m}.id = {s}.module_id"]]

qNote :: Text -> Text -> Select Text
qNote :: Text -> Text -> Select Text
qNote Text
m Text
n = [FormatArg] -> [Select Text] -> Select Text
template [String
"m" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
m, String
"n" String -> Text -> FormatArg
forall a. Formattable a => String -> a -> FormatArg
~% Text
n] [
	[Text] -> Select Text
forall a. [a] -> Select a
select_ [
		Text
"{m}.file",
		Text
"{n}.line", Text
"{n}.column", Text
"{n}.line_to", Text
"{n}.column_to",
		Text
"{n}.severity",
		Text
"{n}.message", Text
"{n}.suggestion"],
	[Text] -> Select Text
forall a. [a] -> Select a
from_ [Text
"modules as {m}", Text
"messages as {n}"],
	[Text] -> Select Text
forall a. [a] -> Select a
where_ [
		Text
"{m}.file is not null",
		Text
"{n}.module_id = {m}.id"]]

template :: [FormatArg] -> [Select Text] -> Select Text
template :: [FormatArg] -> [Select Text] -> Select Text
template [FormatArg]
args = (Text -> Text) -> Select Text -> Select Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> [FormatArg] -> Text
forall r. FormatResult r => String -> [FormatArg] -> r
`formats` [FormatArg]
args) (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Select Text -> Select Text)
-> ([Select Text] -> Select Text) -> [Select Text] -> Select Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Select Text] -> Select Text
forall a. Monoid a => [a] -> a
mconcat