{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}

module HaskellWorks.Data.MQuery where

import Control.Lens
import Control.Monad
import Data.List
import GHC.Base
import HaskellWorks.Data.MQuery.Entry
import HaskellWorks.Data.MQuery.Row
import HaskellWorks.Data.MQuery.ToBool
import Text.PrettyPrint.ANSI.Leijen    hiding ((<>))

import qualified Data.DList as DL

newtype MQuery a = MQuery (DL.DList a)

deriving instance Functor     MQuery
deriving instance Applicative MQuery
deriving instance Monad       MQuery
deriving instance Alternative MQuery
deriving instance MonadPlus   MQuery
deriving instance Foldable    MQuery

class IsPredicate a where
  type ArgOf a
  toPredicate :: ArgOf a -> (a -> Bool)

mQuery :: MQuery a -> DL.DList a
mQuery :: MQuery a -> DList a
mQuery (MQuery DList a
a) = DList a
a

instance ToBool (MQuery a) where
  toBool :: MQuery a -> Bool
toBool = DList a -> Bool
forall a. ToBool a => a -> Bool
toBool (DList a -> Bool) -> (MQuery a -> DList a) -> MQuery a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MQuery a -> DList a
forall a. MQuery a -> DList a
mQuery

instance Pretty (MQuery String) where
  pretty :: MQuery String -> Doc
pretty MQuery String
x = Row (DList String) -> Doc
forall a. Show a => Row (DList a) -> Doc
prettyRowOfString (Int -> DList String -> Row (DList String)
forall a. Int -> a -> Row a
Row Int
120 (MQuery String -> DList String
forall a. MQuery a -> DList a
mQuery MQuery String
x))

instance Pretty (MQuery Integer) where
  pretty :: MQuery Integer -> Doc
pretty MQuery Integer
x = Row (DList Integer) -> Doc
forall a. Show a => Row (DList a) -> Doc
prettyRowOfString (Int -> DList Integer -> Row (DList Integer)
forall a. Int -> a -> Row a
Row Int
120 (MQuery Integer -> DList Integer
forall a. MQuery a -> DList a
mQuery MQuery Integer
x))

instance Pretty (MQuery Int) where
  pretty :: MQuery Int -> Doc
pretty MQuery Int
x = Row (DList Int) -> Doc
forall a. Show a => Row (DList a) -> Doc
prettyRowOfString (Int -> DList Int -> Row (DList Int)
forall a. Int -> a -> Row a
Row Int
120 (MQuery Int -> DList Int
forall a. MQuery a -> DList a
mQuery MQuery Int
x))

satisfying :: (a -> Bool) -> a -> MQuery a
satisfying :: (a -> Bool) -> a -> MQuery a
satisfying a -> Bool
p a
a | a -> Bool
p a
a  = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (DList a -> MQuery a) -> DList a -> MQuery a
forall a b. (a -> b) -> a -> b
$ a -> DList a
forall a. a -> DList a
DL.singleton a
a
satisfying a -> Bool
_ a
_ = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery   DList a
forall a. DList a
DL.empty

key :: Entry k v -> MQuery k
key :: Entry k v -> MQuery k
key (Entry k
k v
_) = DList k -> MQuery k
forall a. DList a -> MQuery a
MQuery (DList k -> MQuery k) -> DList k -> MQuery k
forall a b. (a -> b) -> a -> b
$ k -> DList k
forall a. a -> DList a
DL.singleton k
k

value :: Entry k v -> MQuery v
value :: Entry k v -> MQuery v
value (Entry k
_ v
v) = DList v -> MQuery v
forall a. DList a -> MQuery a
MQuery (DList v -> MQuery v) -> DList v -> MQuery v
forall a b. (a -> b) -> a -> b
$ v -> DList v
forall a. a -> DList a
DL.singleton v
v

dlTake :: Int -> DL.DList a -> DL.DList a
dlTake :: Int -> DList a -> DList a
dlTake Int
n = [a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList

select :: ToBool b => a -> (a -> b) -> MQuery a
select :: a -> (a -> b) -> MQuery a
select a
a a -> b
f = if b -> Bool
forall a. ToBool a => a -> Bool
toBool (a -> b
f a
a) then DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (a -> DList a
forall a. a -> DList a
DL.singleton a
a) else DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery DList a
forall a. DList a
DL.empty

having :: (a -> MQuery b) -> a -> MQuery a
having :: (a -> MQuery b) -> a -> MQuery a
having a -> MQuery b
p a
a = case a -> MQuery b
p a
a of
  MQuery DList b
das -> case DList b -> [b]
forall a. DList a -> [a]
DL.toList DList b
das of
    b
_:[b]
_ -> DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (a -> DList a
forall a. a -> DList a
DL.singleton a
a)
    [b]
_   -> DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery  DList a
forall a. DList a
DL.empty

valueOf :: Eq a => a -> a -> MQuery a
valueOf :: a -> a -> MQuery a
valueOf a
a a
b = if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (a -> DList a
forall a. a -> DList a
DL.singleton a
b) else DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery DList a
forall a. DList a
DL.empty

limit :: Int -> MQuery a -> MQuery a
limit :: Int -> MQuery a -> MQuery a
limit Int
n (MQuery DList a
xs) = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (([a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList) DList a
xs)

skip :: Int -> MQuery a -> MQuery a
skip :: Int -> MQuery a -> MQuery a
skip Int
n (MQuery DList a
xs) = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (([a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList) DList a
xs)

page :: Int -> Int -> MQuery a -> MQuery a
page :: Int -> Int -> MQuery a -> MQuery a
page Int
size Int
n (MQuery DList a
xs) = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (([a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
size ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList) DList a
xs)

sorted :: Ord a => MQuery a -> MQuery a
sorted :: MQuery a -> MQuery a
sorted (MQuery DList a
xs) = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (([a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList) DList a
xs)

onList :: ([a] -> [a]) -> MQuery a -> MQuery a
onList :: ([a] -> [a]) -> MQuery a -> MQuery a
onList [a] -> [a]
f (MQuery DList a
xs) = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (([a] -> DList a
forall a. [a] -> DList a
DL.fromList ([a] -> DList a) -> (DList a -> [a]) -> DList a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f ([a] -> [a]) -> (DList a -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
DL.toList) DList a
xs)

count :: MQuery a -> MQuery Int
count :: MQuery a -> MQuery Int
count (MQuery DList a
xs) = DList Int -> MQuery Int
forall a. DList a -> MQuery a
MQuery (Int -> DList Int
forall a. a -> DList a
DL.singleton ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DList a -> [a]
forall a. DList a -> [a]
DL.toList DList a
xs)))

aggregate :: ([a] -> b) -> MQuery a -> MQuery b
aggregate :: ([a] -> b) -> MQuery a -> MQuery b
aggregate [a] -> b
f (MQuery DList a
xs) = DList b -> MQuery b
forall a. DList a -> MQuery a
MQuery ([b] -> DList b
forall a. [a] -> DList a
DL.fromList [[a] -> b
f (DList a -> [a]
forall a. DList a -> [a]
DL.toList DList a
xs)])

uniq :: Eq a => [a] -> [a]
uniq :: [a] -> [a]
uniq (a
a:a
b:[a]
cs) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b  =   [a] -> [a]
forall a. Eq a => [a] -> [a]
uniq (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)
uniq (a
a:a
b:[a]
cs) = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
forall a. Eq a => [a] -> [a]
uniq (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)
uniq [a]
cs       = [a]
cs

infixl 1 >>^.
infixl 1 >>^..

instance Semigroup (MQuery a) where
  MQuery DList a
a <> :: MQuery a -> MQuery a -> MQuery a
<> MQuery DList a
b = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery (DList a
a DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
`DL.append` DList a
b)

instance Monoid (MQuery a) where
  mempty :: MQuery a
mempty = DList a -> MQuery a
forall a. DList a -> MQuery a
MQuery DList a
forall a. DList a
DL.empty

(/^.) :: Monad m => s -> Getting a s a -> m a
/^. :: s -> Getting a s a -> m a
(/^.) s
a Getting a s a
g = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
a s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
g)

(/^..) :: (Monad m, Foldable t, Monoid (m a)) => s -> Getting (t a) s (t a) -> m a
/^.. :: s -> Getting (t a) s (t a) -> m a
(/^..) s
a Getting (t a) s (t a)
g = (a -> m a) -> t a -> m a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (s
a s -> Getting (t a) s (t a) -> t a
forall s a. s -> Getting a s a -> a
^. Getting (t a) s (t a)
g)

(>>^.) :: Monad m => m a -> Getting b a b -> m b
>>^. :: m a -> Getting b a b -> m b
(>>^.) m a
q Getting b a b
g = m a
q m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Getting b a b -> m b
forall (m :: * -> *) s a. Monad m => s -> Getting a s a -> m a
/^. Getting b a b
g)

(>>^..) :: (Monad m, Foldable t, Monoid (m a), Monoid (m b)) => m a -> Getting (t b) a (t b) -> m b
>>^.. :: m a -> Getting (t b) a (t b) -> m b
(>>^..) m a
q Getting (t b) a (t b)
g = m a
q m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Getting (t b) a (t b) -> m b
forall (m :: * -> *) (t :: * -> *) a s.
(Monad m, Foldable t, Monoid (m a)) =>
s -> Getting (t a) s (t a) -> m a
/^.. Getting (t b) a (t b)
g)