{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
)
type QueryState = (HTMLZipper, IntMap HTMLZipper)
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)
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)])
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
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
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
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
htmlQueryCont :: HTMLQuery ()
htmlQueryCont :: HTMLQuery ()
htmlQueryCont = forall a. a -> HTMLQuery a
htmlQuerySucc ()
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
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
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
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
htmlQueryFirst :: HTMLQuery ()
htmlQueryFirst :: HTMLQuery ()
htmlQueryFirst = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipFirst
htmlQueryLast :: HTMLQuery ()
htmlQueryLast :: HTMLQuery ()
htmlQueryLast = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipLast
htmlQueryNext :: HTMLQuery ()
htmlQueryNext :: HTMLQuery ()
htmlQueryNext = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipNext
htmlQueryPrev :: HTMLQuery ()
htmlQueryPrev :: HTMLQuery ()
htmlQueryPrev = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipPrev
htmlQueryUp :: HTMLQuery ()
htmlQueryUp :: HTMLQuery ()
htmlQueryUp = (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()
withZip HTMLZipper -> Maybe HTMLZipper
htmlZipUp
htmlQueryTest :: Bool -> HTMLQuery ()
htmlQueryTest :: Bool -> HTMLQuery ()
htmlQueryTest = forall a. a -> a -> Bool -> a
bool forall a. HTMLQuery a
htmlQueryStop HTMLQuery ()
htmlQueryCont
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
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
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
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
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
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
htmlQuerySrc :: HTMLQuery HTMLNode
htmlQuerySrc :: HTMLQuery HTMLNode
htmlQuerySrc = Key -> HTMLQuery HTMLNode
htmlQueryGet Key
0
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
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
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
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
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