{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | A basic query facility.
module Zenacy.HTML.Internal.Query
  ( HTMLQuery
  , htmlQueryRun
  , htmlQueryExec
  , htmlQueryTry
  , htmlQueryStop
  , htmlQueryCont
  , htmlQuerySucc
  , htmlQueryZipper
  , htmlQueryNode
  , htmlQueryFirst
  , htmlQueryLast
  , htmlQueryNext
  , htmlQueryPrev
  , htmlQueryUp
  , htmlQueryTest
  , htmlQueryName
  , htmlQueryIsFirst
  , htmlQueryIsLast
  , htmlQuerySave
  , htmlQueryGet
  , htmlQueryGetZipper
  , htmlQuerySrc
  , htmlQueryAttr
  , htmlQueryAttrVal
  , htmlQueryId
  , htmlQueryHasClass
  , htmlQueryOnly
  ) where

import Prelude
import Zenacy.HTML.Internal.HTML
import Zenacy.HTML.Internal.Oper
import Zenacy.HTML.Internal.Zip
import Control.Monad.State
  ( MonadState
  , State
  , evalState
  , modify
  , gets
  )
import Control.Monad.Trans.Maybe
  ( MaybeT(..)
  , runMaybeT
  )
import Data.Bool
  ( bool
  )
import Data.IntMap
  ( IntMap
  )
import qualified Data.IntMap as IntMap
  ( fromList
  , lookup
  , insert
  )
import Data.Maybe
  ( fromMaybe
  , isNothing
  )
import Data.Text
  ( Text
  )

-- | Defines the query state.
type QueryState = (HTMLZipper, IntMap HTMLZipper)

-- | Defines the type for a query.
newtype HTMLQuery a = HTMLQuery { forall a.
HTMLQuery a -> MaybeT (State (HTMLZipper, IntMap HTMLZipper)) a
htmlQueryState :: MaybeT (State QueryState) a }
  deriving (forall a b. a -> HTMLQuery b -> HTMLQuery a
forall a b. (a -> b) -> HTMLQuery a -> HTMLQuery b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HTMLQuery b -> HTMLQuery a
$c<$ :: forall a b. a -> HTMLQuery b -> HTMLQuery a
fmap :: forall a b. (a -> b) -> HTMLQuery a -> HTMLQuery b
$cfmap :: forall a b. (a -> b) -> HTMLQuery a -> HTMLQuery b
Functor, Functor HTMLQuery
forall a. a -> HTMLQuery a
forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery a
forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
forall a b. HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
forall a b c.
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery a
$c<* :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery a
*> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
$c*> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
liftA2 :: forall a b c.
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
<*> :: forall a b. HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
$c<*> :: forall a b. HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
pure :: forall a. a -> HTMLQuery a
$cpure :: forall a. a -> HTMLQuery a
Applicative, Applicative HTMLQuery
forall a. a -> HTMLQuery a
forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
forall a b. HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> HTMLQuery a
$creturn :: forall a. a -> HTMLQuery a
>> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
$c>> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
>>= :: forall a b. HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
$c>>= :: forall a b. HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
Monad, MonadState QueryState)

-- | Runs a query and returns a result.
htmlQueryRun :: HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun :: forall a. HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun HTMLNode
x HTMLQuery a
q = forall s a. State s a -> s -> a
evalState (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ forall a.
HTMLQuery a -> MaybeT (State (HTMLZipper, IntMap HTMLZipper)) a
htmlQueryState HTMLQuery a
q) (HTMLZipper, IntMap HTMLZipper)
s
  where
    z :: HTMLZipper
z = HTMLNode -> HTMLZipper
htmlZip HTMLNode
x
    s :: (HTMLZipper, IntMap HTMLZipper)
s = (HTMLZipper
z, forall a. [(Key, a)] -> IntMap a
IntMap.fromList [(Key
0,HTMLZipper
z)])

-- | Same as run with the arguments flipped.
htmlQueryExec :: HTMLQuery a -> HTMLNode -> Maybe a
htmlQueryExec :: forall a. HTMLQuery a -> HTMLNode -> Maybe a
htmlQueryExec = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun

-- | Same as run with the arguments flipped.
htmlQueryTry :: HTMLQuery HTMLNode -> HTMLNode -> HTMLNode
htmlQueryTry :: HTMLQuery HTMLNode -> HTMLNode -> HTMLNode
htmlQueryTry HTMLQuery HTMLNode
q HTMLNode
x = forall a. a -> Maybe a -> a
fromMaybe HTMLNode
x forall a b. (a -> b) -> a -> b
$ forall a. HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun HTMLNode
x HTMLQuery HTMLNode
q

-- | Wraps a value as a query result.
htmlQueryWrap :: Maybe a -> HTMLQuery a
htmlQueryWrap :: forall a. Maybe a -> HTMLQuery a
htmlQueryWrap = forall a.
MaybeT (State (HTMLZipper, IntMap HTMLZipper)) a -> HTMLQuery a
HTMLQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Returns a result that stops the query.
htmlQueryStop :: HTMLQuery a
htmlQueryStop :: forall a. HTMLQuery a
htmlQueryStop = forall a. Maybe a -> HTMLQuery a
htmlQueryWrap forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing

-- | Returns a result that continues the query.
htmlQueryCont :: HTMLQuery ()
htmlQueryCont :: HTMLQuery ()
htmlQueryCont = forall a. a -> HTMLQuery a
htmlQuerySucc ()

-- | Returns a successful query result.
htmlQuerySucc :: a -> HTMLQuery a
htmlQuerySucc :: forall a. a -> HTMLQuery a
htmlQuerySucc = forall a. Maybe a -> HTMLQuery a
htmlQueryWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

-- | Gets the current query zipper.
htmlQueryZipper :: HTMLQuery HTMLZipper
htmlQueryZipper :: HTMLQuery HTMLZipper
htmlQueryZipper = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a, b) -> a
fst

-- | Gets the current query node.
htmlQueryNode :: HTMLQuery HTMLNode
htmlQueryNode :: HTMLQuery HTMLNode
htmlQueryNode = HTMLZipper -> HTMLNode
htmlZipNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HTMLQuery HTMLZipper
htmlQueryZipper

-- | Performs a query step with a zipper operation.
withZip :: (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip :: (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
f = do
  HTMLZipper
z <- HTMLQuery HTMLZipper
htmlQueryZipper
  case HTMLZipper -> Maybe HTMLZipper
f HTMLZipper
z of
    Maybe HTMLZipper
Nothing ->
      forall a. HTMLQuery a
htmlQueryStop
    Just HTMLZipper
z' -> do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \(HTMLZipper
_, IntMap HTMLZipper
m) -> (HTMLZipper
z', IntMap HTMLZipper
m)
      HTMLQuery ()
htmlQueryCont

-- | Moves the query to the first child node.
htmlQueryFirst :: HTMLQuery ()
htmlQueryFirst :: HTMLQuery ()
htmlQueryFirst = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipFirst

-- | Moves the query to the last child node.
htmlQueryLast :: HTMLQuery ()
htmlQueryLast :: HTMLQuery ()
htmlQueryLast = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipLast

-- | Moves the query to the next sibling node.
htmlQueryNext :: HTMLQuery ()
htmlQueryNext :: HTMLQuery ()
htmlQueryNext = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipNext

-- | Moves the query to the previous sibling node.
htmlQueryPrev :: HTMLQuery ()
htmlQueryPrev :: HTMLQuery ()
htmlQueryPrev = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipPrev

-- | Moves the query to the parent node.
htmlQueryUp :: HTMLQuery ()
htmlQueryUp :: HTMLQuery ()
htmlQueryUp = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipUp

-- | Evaluates a test result and continues the query if true.
htmlQueryTest :: Bool -> HTMLQuery ()
htmlQueryTest :: Bool -> HTMLQuery ()
htmlQueryTest = forall a. a -> a -> Bool -> a
bool forall a. HTMLQuery a
htmlQueryStop HTMLQuery ()
htmlQueryCont

-- | Tests the current element name.
htmlQueryName :: Text -> HTMLQuery ()
htmlQueryName :: Text -> HTMLQuery ()
htmlQueryName Text
x = do
  HTMLNode
n <- HTMLQuery HTMLNode
htmlQueryNode
  Bool -> HTMLQuery ()
htmlQueryTest forall a b. (a -> b) -> a -> b
$ HTMLNode -> Text
htmlElemName HTMLNode
n forall a. Eq a => a -> a -> Bool
== Text
x

-- | Tests the current node to see if it is the first sibling.
htmlQueryIsFirst :: HTMLQuery ()
htmlQueryIsFirst :: HTMLQuery ()
htmlQueryIsFirst = do
  HTMLZipper
z <- HTMLQuery HTMLZipper
htmlQueryZipper
  Bool -> HTMLQuery ()
htmlQueryTest forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ HTMLZipper -> Maybe HTMLZipper
htmlZipPrev HTMLZipper
z

-- | Tests the current node to see if it is the last sibling.
htmlQueryIsLast :: HTMLQuery ()
htmlQueryIsLast :: HTMLQuery ()
htmlQueryIsLast = do
  HTMLZipper
z <- HTMLQuery HTMLZipper
htmlQueryZipper
  Bool -> HTMLQuery ()
htmlQueryTest forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ HTMLZipper -> Maybe HTMLZipper
htmlZipNext HTMLZipper
z

-- | Saves the current query state.
htmlQuerySave :: Int -> HTMLQuery ()
htmlQuerySave :: Key -> HTMLQuery ()
htmlQuerySave Key
x = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \(HTMLZipper
z, IntMap HTMLZipper
m) -> (HTMLZipper
z, forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert Key
x HTMLZipper
z IntMap HTMLZipper
m)
  HTMLQuery ()
htmlQueryCont

-- | Gets a saved query node.
htmlQueryGet :: Int -> HTMLQuery HTMLNode
htmlQueryGet :: Key -> HTMLQuery HTMLNode
htmlQueryGet Key
x = HTMLZipper -> HTMLNode
htmlZipNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> HTMLQuery HTMLZipper
htmlQueryGetZipper Key
x

-- | Gets a saved query zipper.
htmlQueryGetZipper :: Int -> HTMLQuery HTMLZipper
htmlQueryGetZipper :: Key -> HTMLQuery HTMLZipper
htmlQueryGetZipper Key
x = do
  IntMap HTMLZipper
m <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a, b) -> b
snd
  case forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
x IntMap HTMLZipper
m of
    Just HTMLZipper
z -> forall a. a -> HTMLQuery a
htmlQuerySucc HTMLZipper
z
    Maybe HTMLZipper
Nothing -> forall a. HTMLQuery a
htmlQueryStop

-- | Gets the source input node.
htmlQuerySrc :: HTMLQuery HTMLNode
htmlQuerySrc :: HTMLQuery HTMLNode
htmlQuerySrc = Key -> HTMLQuery HTMLNode
htmlQueryGet Key
0

-- | Tests if the current node has an attribute.
htmlQueryAttr :: Text -> HTMLQuery ()
htmlQueryAttr :: Text -> HTMLQuery ()
htmlQueryAttr Text
x = HTMLQuery HTMLNode
htmlQueryNode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HTMLNode -> Bool
htmlElemHasAttrName Text
x

-- | Tests if the current node has an attribute value.
htmlQueryAttrVal :: Text -> Text -> HTMLQuery ()
htmlQueryAttrVal :: Text -> Text -> HTMLQuery ()
htmlQueryAttrVal Text
n Text
v = HTMLQuery HTMLNode
htmlQueryNode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> HTMLNode -> Bool
htmlElemHasAttrVal Text
n Text
v

-- | Tests if the current node has an id.
htmlQueryId :: Text -> HTMLQuery ()
htmlQueryId :: Text -> HTMLQuery ()
htmlQueryId Text
x = HTMLQuery HTMLNode
htmlQueryNode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HTMLNode -> Bool
htmlElemHasID Text
x

-- | Tests if the current node has a class.
htmlQueryHasClass :: Text -> HTMLQuery ()
htmlQueryHasClass :: Text -> HTMLQuery ()
htmlQueryHasClass Text
x = HTMLQuery HTMLNode
htmlQueryNode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HTMLNode -> Bool
htmlElemClassesContains Text
x

-- | Moves to the child and require that it is the only child.
htmlQueryOnly :: Text -> HTMLQuery ()
htmlQueryOnly :: Text -> HTMLQuery ()
htmlQueryOnly Text
x = HTMLQuery ()
htmlQueryFirst forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> HTMLQuery ()
htmlQueryName Text
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HTMLQuery ()
htmlQueryIsLast