{-# 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 { HTMLQuery a -> MaybeT (State QueryState) a
htmlQueryState :: MaybeT (State QueryState) a }
deriving (a -> HTMLQuery b -> HTMLQuery a
(a -> b) -> HTMLQuery a -> HTMLQuery b
(forall a b. (a -> b) -> HTMLQuery a -> HTMLQuery b)
-> (forall a b. a -> HTMLQuery b -> HTMLQuery a)
-> Functor HTMLQuery
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
<$ :: a -> HTMLQuery b -> HTMLQuery a
$c<$ :: forall a b. a -> HTMLQuery b -> HTMLQuery a
fmap :: (a -> b) -> HTMLQuery a -> HTMLQuery b
$cfmap :: forall a b. (a -> b) -> HTMLQuery a -> HTMLQuery b
Functor, Functor HTMLQuery
a -> HTMLQuery a
Functor HTMLQuery
-> (forall a. a -> HTMLQuery a)
-> (forall a b. HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b)
-> (forall a b c.
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c)
-> (forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b)
-> (forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery a)
-> Applicative HTMLQuery
HTMLQuery a -> HTMLQuery b -> HTMLQuery b
HTMLQuery a -> HTMLQuery b -> HTMLQuery a
HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
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
<* :: HTMLQuery a -> HTMLQuery b -> HTMLQuery a
$c<* :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery a
*> :: HTMLQuery a -> HTMLQuery b -> HTMLQuery b
$c*> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
liftA2 :: (a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
$cliftA2 :: forall a b c.
(a -> b -> c) -> HTMLQuery a -> HTMLQuery b -> HTMLQuery c
<*> :: HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
$c<*> :: forall a b. HTMLQuery (a -> b) -> HTMLQuery a -> HTMLQuery b
pure :: a -> HTMLQuery a
$cpure :: forall a. a -> HTMLQuery a
$cp1Applicative :: Functor HTMLQuery
Applicative, Applicative HTMLQuery
a -> HTMLQuery a
Applicative HTMLQuery
-> (forall a b. HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b)
-> (forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b)
-> (forall a. a -> HTMLQuery a)
-> Monad HTMLQuery
HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
HTMLQuery a -> HTMLQuery b -> HTMLQuery b
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 :: a -> HTMLQuery a
$creturn :: forall a. a -> HTMLQuery a
>> :: HTMLQuery a -> HTMLQuery b -> HTMLQuery b
$c>> :: forall a b. HTMLQuery a -> HTMLQuery b -> HTMLQuery b
>>= :: HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
$c>>= :: forall a b. HTMLQuery a -> (a -> HTMLQuery b) -> HTMLQuery b
$cp1Monad :: Applicative HTMLQuery
Monad, MonadState QueryState)
htmlQueryRun :: HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun :: HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun HTMLNode
x HTMLQuery a
q = State QueryState (Maybe a) -> QueryState -> Maybe a
forall s a. State s a -> s -> a
evalState (MaybeT (State QueryState) a -> State QueryState (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (State QueryState) a -> State QueryState (Maybe a))
-> MaybeT (State QueryState) a -> State QueryState (Maybe a)
forall a b. (a -> b) -> a -> b
$ HTMLQuery a -> MaybeT (State QueryState) a
forall a. HTMLQuery a -> MaybeT (State QueryState) a
htmlQueryState HTMLQuery a
q) QueryState
s
where
z :: HTMLZipper
z = HTMLNode -> HTMLZipper
htmlZip HTMLNode
x
s :: QueryState
s = (HTMLZipper
z, [(Key, HTMLZipper)] -> IntMap HTMLZipper
forall a. [(Key, a)] -> IntMap a
IntMap.fromList [(Key
0,HTMLZipper
z)])
htmlQueryExec :: HTMLQuery a -> HTMLNode -> Maybe a
htmlQueryExec :: HTMLQuery a -> HTMLNode -> Maybe a
htmlQueryExec = (HTMLNode -> HTMLQuery a -> Maybe a)
-> HTMLQuery a -> HTMLNode -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HTMLNode -> HTMLQuery a -> Maybe a
forall a. HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun
htmlQueryTry :: HTMLQuery HTMLNode -> HTMLNode -> HTMLNode
htmlQueryTry :: HTMLQuery HTMLNode -> HTMLNode -> HTMLNode
htmlQueryTry HTMLQuery HTMLNode
q HTMLNode
x = HTMLNode -> Maybe HTMLNode -> HTMLNode
forall a. a -> Maybe a -> a
fromMaybe HTMLNode
x (Maybe HTMLNode -> HTMLNode) -> Maybe HTMLNode -> HTMLNode
forall a b. (a -> b) -> a -> b
$ HTMLNode -> HTMLQuery HTMLNode -> Maybe HTMLNode
forall a. HTMLNode -> HTMLQuery a -> Maybe a
htmlQueryRun HTMLNode
x HTMLQuery HTMLNode
q
htmlQueryWrap :: Maybe a -> HTMLQuery a
htmlQueryWrap :: Maybe a -> HTMLQuery a
htmlQueryWrap = MaybeT (State QueryState) a -> HTMLQuery a
forall a. MaybeT (State QueryState) a -> HTMLQuery a
HTMLQuery (MaybeT (State QueryState) a -> HTMLQuery a)
-> (Maybe a -> MaybeT (State QueryState) a)
-> Maybe a
-> HTMLQuery a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State QueryState (Maybe a) -> MaybeT (State QueryState) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (State QueryState (Maybe a) -> MaybeT (State QueryState) a)
-> (Maybe a -> State QueryState (Maybe a))
-> Maybe a
-> MaybeT (State QueryState) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> State QueryState (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
htmlQueryStop :: HTMLQuery a
htmlQueryStop :: HTMLQuery a
htmlQueryStop = Maybe a -> HTMLQuery a
forall a. Maybe a -> HTMLQuery a
htmlQueryWrap (Maybe a -> HTMLQuery a) -> Maybe a -> HTMLQuery a
forall a b. (a -> b) -> a -> b
$ Maybe a
forall a. Maybe a
Nothing
htmlQueryCont :: HTMLQuery ()
htmlQueryCont :: HTMLQuery ()
htmlQueryCont = () -> HTMLQuery ()
forall a. a -> HTMLQuery a
htmlQuerySucc ()
htmlQuerySucc :: a -> HTMLQuery a
htmlQuerySucc :: a -> HTMLQuery a
htmlQuerySucc = Maybe a -> HTMLQuery a
forall a. Maybe a -> HTMLQuery a
htmlQueryWrap (Maybe a -> HTMLQuery a) -> (a -> Maybe a) -> a -> HTMLQuery a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
htmlQueryZipper :: HTMLQuery HTMLZipper
htmlQueryZipper :: HTMLQuery HTMLZipper
htmlQueryZipper = (QueryState -> HTMLZipper) -> HTMLQuery HTMLZipper
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets QueryState -> HTMLZipper
forall a b. (a, b) -> a
fst
htmlQueryNode :: HTMLQuery HTMLNode
htmlQueryNode :: HTMLQuery HTMLNode
htmlQueryNode = HTMLZipper -> HTMLNode
htmlZipNode (HTMLZipper -> HTMLNode)
-> HTMLQuery HTMLZipper -> HTMLQuery HTMLNode
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 ->
HTMLQuery ()
forall a. HTMLQuery a
htmlQueryStop
Just HTMLZipper
z' -> do
(QueryState -> QueryState) -> HTMLQuery ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((QueryState -> QueryState) -> HTMLQuery ())
-> (QueryState -> QueryState) -> HTMLQuery ()
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 = HTMLQuery () -> HTMLQuery () -> Bool -> HTMLQuery ()
forall a. a -> a -> Bool -> a
bool HTMLQuery ()
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 (Bool -> HTMLQuery ()) -> Bool -> HTMLQuery ()
forall a b. (a -> b) -> a -> b
$ HTMLNode -> Text
htmlElemName HTMLNode
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x
htmlQueryIsFirst :: HTMLQuery ()
htmlQueryIsFirst :: HTMLQuery ()
htmlQueryIsFirst = do
HTMLZipper
z <- HTMLQuery HTMLZipper
htmlQueryZipper
Bool -> HTMLQuery ()
htmlQueryTest (Bool -> HTMLQuery ()) -> Bool -> HTMLQuery ()
forall a b. (a -> b) -> a -> b
$ Maybe HTMLZipper -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe HTMLZipper -> Bool) -> Maybe HTMLZipper -> Bool
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 (Bool -> HTMLQuery ()) -> Bool -> HTMLQuery ()
forall a b. (a -> b) -> a -> b
$ Maybe HTMLZipper -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe HTMLZipper -> Bool) -> Maybe HTMLZipper -> Bool
forall a b. (a -> b) -> a -> b
$ HTMLZipper -> Maybe HTMLZipper
htmlZipNext HTMLZipper
z
htmlQuerySave :: Int -> HTMLQuery ()
htmlQuerySave :: Key -> HTMLQuery ()
htmlQuerySave Key
x = do
(QueryState -> QueryState) -> HTMLQuery ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((QueryState -> QueryState) -> HTMLQuery ())
-> (QueryState -> QueryState) -> HTMLQuery ()
forall a b. (a -> b) -> a -> b
$ \(HTMLZipper
z, IntMap HTMLZipper
m) -> (HTMLZipper
z, Key -> HTMLZipper -> IntMap HTMLZipper -> IntMap HTMLZipper
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 (HTMLZipper -> HTMLNode)
-> HTMLQuery HTMLZipper -> HTMLQuery HTMLNode
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 <- (QueryState -> IntMap HTMLZipper) -> HTMLQuery (IntMap HTMLZipper)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets QueryState -> IntMap HTMLZipper
forall a b. (a, b) -> b
snd
case Key -> IntMap HTMLZipper -> Maybe HTMLZipper
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
x IntMap HTMLZipper
m of
Just HTMLZipper
z -> HTMLZipper -> HTMLQuery HTMLZipper
forall a. a -> HTMLQuery a
htmlQuerySucc HTMLZipper
z
Maybe HTMLZipper
Nothing -> HTMLQuery HTMLZipper
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 HTMLQuery HTMLNode -> (HTMLNode -> HTMLQuery ()) -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest (Bool -> HTMLQuery ())
-> (HTMLNode -> Bool) -> HTMLNode -> HTMLQuery ()
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 HTMLQuery HTMLNode -> (HTMLNode -> HTMLQuery ()) -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest (Bool -> HTMLQuery ())
-> (HTMLNode -> Bool) -> HTMLNode -> HTMLQuery ()
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 HTMLQuery HTMLNode -> (HTMLNode -> HTMLQuery ()) -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest (Bool -> HTMLQuery ())
-> (HTMLNode -> Bool) -> HTMLNode -> HTMLQuery ()
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 HTMLQuery HTMLNode -> (HTMLNode -> HTMLQuery ()) -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> HTMLQuery ()
htmlQueryTest (Bool -> HTMLQuery ())
-> (HTMLNode -> Bool) -> HTMLNode -> HTMLQuery ()
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 HTMLQuery () -> HTMLQuery () -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> HTMLQuery ()
htmlQueryName Text
x HTMLQuery () -> HTMLQuery () -> HTMLQuery ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HTMLQuery ()
htmlQueryIsLast