{-# LANGUAGE LambdaCase #-}
module Text.Seonbi.Html.Clipper
( clipPrefixText
, clipSuffixText
, clipText
) where
import Control.Monad
import Data.List (dropWhileEnd)
import Data.Text
import Text.Seonbi.Html
clipText :: Text -> Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipText :: Text -> Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipText Text
prefix Text
suffix =
Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipSuffixText Text
suffix ([HtmlEntity] -> Maybe [HtmlEntity])
-> ([HtmlEntity] -> Maybe [HtmlEntity])
-> [HtmlEntity]
-> Maybe [HtmlEntity]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipPrefixText Text
prefix
clipPrefixText :: Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipPrefixText :: Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipPrefixText Text
prefix []
| Text -> Bool
Data.Text.null Text
prefix = [HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just []
| Bool
otherwise = Maybe [HtmlEntity]
forall a. Maybe a
Nothing
clipPrefixText Text
prefix (x :: HtmlEntity
x@HtmlComment {} : [HtmlEntity]
xs) =
(HtmlEntity
x HtmlEntity -> [HtmlEntity] -> [HtmlEntity]
forall a. a -> [a] -> [a]
:) ([HtmlEntity] -> [HtmlEntity])
-> Maybe [HtmlEntity] -> Maybe [HtmlEntity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipPrefixText Text
prefix [HtmlEntity]
xs
clipPrefixText Text
prefix (x :: HtmlEntity
x@HtmlText { rawText :: HtmlEntity -> Text
rawText = Text
rawText' } : [HtmlEntity]
xs)
| Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rawText' = [HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just [HtmlEntity]
xs
| Text
prefix Text -> Text -> Bool
`isPrefixOf` Text
rawText' = [HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just ([HtmlEntity] -> Maybe [HtmlEntity])
-> [HtmlEntity] -> Maybe [HtmlEntity]
forall a b. (a -> b) -> a -> b
$
HtmlEntity
x { rawText :: Text
rawText = Int -> Text -> Text
Data.Text.drop (Text -> Int
Data.Text.length Text
prefix) Text
rawText' } HtmlEntity -> [HtmlEntity] -> [HtmlEntity]
forall a. a -> [a] -> [a]
: [HtmlEntity]
xs
| Bool
otherwise = Maybe [HtmlEntity]
forall a. Maybe a
Nothing
clipPrefixText Text
_ [HtmlEntity]
_ = Maybe [HtmlEntity]
forall a. Maybe a
Nothing
clipSuffixText :: Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipSuffixText :: Text -> [HtmlEntity] -> Maybe [HtmlEntity]
clipSuffixText Text
suffix []
| Text -> Bool
Data.Text.null Text
suffix = [HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just []
| Bool
otherwise = Maybe [HtmlEntity]
forall a. Maybe a
Nothing
clipSuffixText Text
suffix [HtmlEntity]
entities =
case [HtmlEntity] -> HtmlEntity
forall a. [a] -> a
Prelude.last [HtmlEntity]
entities' of
e :: HtmlEntity
e@HtmlText { rawText :: HtmlEntity -> Text
rawText = Text
rawText' }
| Text
suffix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rawText' -> [HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just ([HtmlEntity]
init' [HtmlEntity] -> [HtmlEntity] -> [HtmlEntity]
forall a. [a] -> [a] -> [a]
++ [HtmlEntity]
comments)
| Text
suffix Text -> Text -> Bool
`isSuffixOf` Text
rawText' ->
let
sLen :: Int
sLen = Text -> Int
Data.Text.length Text
suffix
rtLen :: Int
rtLen = Text -> Int
Data.Text.length Text
rawText'
clipped :: Text
clipped = Int -> Text -> Text
Data.Text.take (Int
rtLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sLen) Text
rawText'
in
[HtmlEntity] -> Maybe [HtmlEntity]
forall a. a -> Maybe a
Just ([HtmlEntity]
init' [HtmlEntity] -> [HtmlEntity] -> [HtmlEntity]
forall a. [a] -> [a] -> [a]
++ HtmlEntity
e { rawText :: Text
rawText = Text
clipped } HtmlEntity -> [HtmlEntity] -> [HtmlEntity]
forall a. a -> [a] -> [a]
: [HtmlEntity]
comments)
| Bool
otherwise -> Maybe [HtmlEntity]
forall a. Maybe a
Nothing
HtmlEntity
_ -> Maybe [HtmlEntity]
forall a. Maybe a
Nothing
where
entities' :: [HtmlEntity]
entities' :: [HtmlEntity]
entities' = ((HtmlEntity -> Bool) -> [HtmlEntity] -> [HtmlEntity]
forall a. (a -> Bool) -> [a] -> [a]
`Data.List.dropWhileEnd` [HtmlEntity]
entities) ((HtmlEntity -> Bool) -> [HtmlEntity])
-> (HtmlEntity -> Bool) -> [HtmlEntity]
forall a b. (a -> b) -> a -> b
$ \ case
HtmlComment {} -> Bool
True
HtmlEntity
_ -> Bool
False
init' :: [HtmlEntity]
init' :: [HtmlEntity]
init' = [HtmlEntity] -> [HtmlEntity]
forall a. [a] -> [a]
Prelude.init [HtmlEntity]
entities'
comments :: [HtmlEntity]
comments :: [HtmlEntity]
comments = Int -> [HtmlEntity] -> [HtmlEntity]
forall a. Int -> [a] -> [a]
Prelude.drop ([HtmlEntity] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [HtmlEntity]
entities') [HtmlEntity]
entities