{-# LANGUAGE DeriveFunctor #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Codec.Winery.Query
-- Copyright   :  (c) Fumiaki Kinoshita 2019
-- License     :  BSD3
-- Stability   :  Experimental
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Building blocks for winery queries.
--
-----------------------------------------------------------------------------
module Codec.Winery.Query (Query(..)
  , invalid
  , list
  , range
  , field
  , productItem
  , con
  , select) where

import Prelude hiding ((.), id)
import Control.Applicative
import Control.Category
import Codec.Winery
import Codec.Winery.Internal
import Data.Typeable
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM

-- | Query is a transformation between 'Extractor's.
-- Like jq, this returns a list of values.
newtype Query a b = Query
  { forall a b. Query a b -> Extractor [a] -> Extractor [b]
runQuery :: Extractor [a] -> Extractor [b] }
  deriving (forall a b. (a -> b) -> Query a a -> Query a b)
-> (forall a b. a -> Query a b -> Query a a) -> Functor (Query a)
forall a b. a -> Query a b -> Query a a
forall a b. (a -> b) -> Query a a -> Query a b
forall a a b. a -> Query a b -> Query a a
forall a a b. (a -> b) -> Query a a -> Query a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> Query a a -> Query a b
fmap :: forall a b. (a -> b) -> Query a a -> Query a b
$c<$ :: forall a a b. a -> Query a b -> Query a a
<$ :: forall a b. a -> Query a b -> Query a a
Functor

instance Category Query where
  id :: forall a. Query a a
id = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query Extractor [a] -> Extractor [a]
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Query Extractor [b] -> Extractor [c]
f . :: forall b c a. Query b c -> Query a b -> Query a c
. Query Extractor [a] -> Extractor [b]
g = (Extractor [a] -> Extractor [c]) -> Query a c
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [c]) -> Query a c)
-> (Extractor [a] -> Extractor [c]) -> Query a c
forall a b. (a -> b) -> a -> b
$ Extractor [b] -> Extractor [c]
f (Extractor [b] -> Extractor [c])
-> (Extractor [a] -> Extractor [b])
-> Extractor [a]
-> Extractor [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Extractor [a] -> Extractor [b]
g

instance Applicative (Query a) where
  pure :: forall a. a -> Query a a
pure a
a = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ Extractor [a] -> Extractor [a] -> Extractor [a]
forall a b. a -> b -> a
const (Extractor [a] -> Extractor [a] -> Extractor [a])
-> Extractor [a] -> Extractor [a] -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Extractor [a]
forall a. a -> Extractor a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a
a]
  Query Extractor [a] -> Extractor [a -> b]
f <*> :: forall a b. Query a (a -> b) -> Query a a -> Query a b
<*> Query Extractor [a] -> Extractor [a]
g = (Extractor [a] -> Extractor [b]) -> Query a b
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [b]) -> Query a b)
-> (Extractor [a] -> Extractor [b]) -> Query a b
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> [a -> b] -> [a] -> [b]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ([a -> b] -> [a] -> [b])
-> Extractor [a -> b] -> Extractor ([a] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [a] -> Extractor [a -> b]
f Extractor [a]
d Extractor ([a] -> [b]) -> Extractor [a] -> Extractor [b]
forall a b. Extractor (a -> b) -> Extractor a -> Extractor b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Extractor [a] -> Extractor [a]
g Extractor [a]
d

instance Alternative (Query a) where
  empty :: forall a. Query a a
empty = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ Extractor [a] -> Extractor [a] -> Extractor [a]
forall a b. a -> b -> a
const (Extractor [a] -> Extractor [a] -> Extractor [a])
-> Extractor [a] -> Extractor [a] -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Extractor [a]
forall a. a -> Extractor a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  Query Extractor [a] -> Extractor [a]
f <|> :: forall a. Query a a -> Query a a -> Query a a
<|> Query Extractor [a] -> Extractor [a]
g = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([a] -> [a] -> [a]) -> Extractor [a] -> Extractor ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [a] -> Extractor [a]
f Extractor [a]
d Extractor ([a] -> [a]) -> Extractor [a] -> Extractor [a]
forall a b. Extractor (a -> b) -> Extractor a -> Extractor b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Extractor [a] -> Extractor [a]
g Extractor [a]
d

-- | Throw an error.
invalid :: WineryException -> Query a b
invalid :: forall a b. WineryException -> Query a b
invalid = (Extractor [a] -> Extractor [b]) -> Query a b
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [b]) -> Query a b)
-> (WineryException -> Extractor [a] -> Extractor [b])
-> WineryException
-> Query a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Extractor [b] -> Extractor [a] -> Extractor [b]
forall a b. a -> b -> a
const (Extractor [b] -> Extractor [a] -> Extractor [b])
-> (WineryException -> Extractor [b])
-> WineryException
-> Extractor [a]
-> Extractor [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Schema -> Strategy' (Term -> [b])) -> Extractor [b]
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor ((Schema -> Strategy' (Term -> [b])) -> Extractor [b])
-> (WineryException -> Schema -> Strategy' (Term -> [b]))
-> WineryException
-> Extractor [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Strategy' (Term -> [b]) -> Schema -> Strategy' (Term -> [b])
forall a b. a -> b -> a
const (Strategy' (Term -> [b]) -> Schema -> Strategy' (Term -> [b]))
-> (WineryException -> Strategy' (Term -> [b]))
-> WineryException
-> Schema
-> Strategy' (Term -> [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WineryException -> Strategy' (Term -> [b])
forall e r a. e -> Strategy e r a
throwStrategy

-- | Takes a list and traverses on it.
list :: Typeable a => Query a a
list :: forall a. Typeable a => Query a a
list = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ (Vector [a] -> [a]) -> Extractor (Vector [a]) -> Extractor [a]
forall a b. (a -> b) -> Extractor a -> Extractor b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector [a] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Extractor (Vector [a]) -> Extractor [a])
-> (Extractor [a] -> Extractor (Vector [a]))
-> Extractor [a]
-> Extractor [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Extractor [a] -> Extractor (Vector [a])
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy

-- | Takes a list and enumerates elements in the specified range.
-- Like Python's array slicing, negative numbers counts from the last element.
range :: Typeable a => Int -> Int -> Query a a
range :: forall a. Typeable a => Int -> Int -> Query a a
range Int
i Int
j = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ (Vector [a] -> [a]) -> Extractor (Vector [a]) -> Extractor [a]
forall a b. (a -> b) -> Extractor a -> Extractor b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Vector [a]
v -> ([a] -> [a]) -> Vector [a] -> [a]
forall m a. Monoid m => (a -> m) -> Vector a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [a] -> [a]
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  (Vector [a] -> [a]) -> Vector [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Vector [a] -> Vector Int -> Vector [a]
forall a. Vector a -> Vector Int -> Vector a
V.backpermute Vector [a]
v (Int -> Int -> Vector Int
forall a. Enum a => a -> a -> Vector a
V.enumFromTo (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Vector [a] -> Int
forall a. Vector a -> Int
V.length Vector [a]
v) (Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Vector [a] -> Int
forall a. Vector a -> Int
V.length Vector [a]
v)))
  (Extractor (Vector [a]) -> Extractor [a])
-> (Extractor [a] -> Extractor (Vector [a]))
-> Extractor [a]
-> Extractor [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Extractor [a] -> Extractor (Vector [a])
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy

productItem :: Typeable a => Int -> Query a a
productItem :: forall a. Typeable a => Int -> Query a a
productItem Int
i = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> Subextractor [a] -> Extractor [a]
forall a. Typeable a => Subextractor a -> Extractor a
buildExtractor (Subextractor [a] -> Extractor [a])
-> Subextractor [a] -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ Extractor [a] -> Int -> Subextractor [a]
forall a. Extractor a -> Int -> Subextractor a
extractProductItemBy Extractor [a]
d Int
i

-- | Takes a record and extracts the specified field.
field :: Typeable a => T.Text -> Query a a
field :: forall a. Typeable a => Text -> Query a a
field Text
name = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> Subextractor [a] -> Extractor [a]
forall a. Typeable a => Subextractor a -> Extractor a
buildExtractor (Subextractor [a] -> Extractor [a])
-> Subextractor [a] -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ Extractor [a] -> Text -> Subextractor [a]
forall a. Extractor a -> Text -> Subextractor a
extractFieldBy Extractor [a]
d Text
name

-- | Takes a variant and returns a value when the constructor matches.
con :: Typeable a => T.Text -> Query a a
con :: forall a. Typeable a => Text -> Query a a
con Text
name = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> HashMap Text (Extractor [a]) -> Extractor [a]
forall a.
(Generic a, Typeable a) =>
HashMap Text (Extractor a) -> Extractor a
buildVariantExtractor (HashMap Text (Extractor [a]) -> Extractor [a])
-> HashMap Text (Extractor [a]) -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ Text -> Extractor [a] -> HashMap Text (Extractor [a])
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Text
name Extractor [a]
d

-- | Propagate values if the supplied 'Query' doesn't return False.
select :: Query a Bool -> Query a a
select :: forall a. Query a Bool -> Query a a
select Query a Bool
qp = (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (Extractor [a] -> Extractor [b]) -> Query a b
Query ((Extractor [a] -> Extractor [a]) -> Query a a)
-> (Extractor [a] -> Extractor [a]) -> Query a a
forall a b. (a -> b) -> a -> b
$ \Extractor [a]
d -> (Schema -> Strategy' (Term -> [a])) -> Extractor [a]
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor ((Schema -> Strategy' (Term -> [a])) -> Extractor [a])
-> (Schema -> Strategy' (Term -> [a])) -> Extractor [a]
forall a b. (a -> b) -> a -> b
$ \Schema
sch -> do
  Term -> [Bool]
p <- Extractor [Bool] -> Schema -> Strategy' (Term -> [Bool])
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor (Query a Bool -> Extractor [a] -> Extractor [Bool]
forall a b. Query a b -> Extractor [a] -> Extractor [b]
runQuery Query a Bool
qp Extractor [a]
d) Schema
sch
  Term -> [a]
dec <- Extractor [a] -> Schema -> Strategy' (Term -> [a])
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor Extractor [a]
d Schema
sch
  (Term -> [a]) -> Strategy' (Term -> [a])
forall a. a -> Strategy WineryException StrategyEnv a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Term -> [a]) -> Strategy' (Term -> [a]))
-> (Term -> [a]) -> Strategy' (Term -> [a])
forall a b. (a -> b) -> a -> b
$ \Term
bs -> [a
x | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Term -> [Bool]
p Term
bs, a
x <- Term -> [a]
dec Term
bs]