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

-- | Defines core functions that augment the prelude.
module Zenacy.HTML.Internal.Core
  ( updateSTRef
  , rref
  , wref
  , uref
  , findSucc
  , insertBefore
  , removeFirst
  , textExtract
  , textBlank
  , textReadDec
  ) where

import Data.Text
  ( Text
  )
import qualified Data.Text as T
  ( breakOn
  , drop
  , length
  , null
  , replicate
  , singleton
  , unpack
  )
import Control.Monad.ST
  ( ST
  )
import Data.STRef
  ( STRef
  , readSTRef
  , writeSTRef
  )
import qualified Numeric as N
  ( readDec
  )

-- | Updates an STRef by applying a function to its value.
updateSTRef :: STRef s a -> (a -> a) -> ST s ()
updateSTRef :: STRef s a -> (a -> a) -> ST s ()
updateSTRef STRef s a
r a -> a
f = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef STRef s a
r ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s a
r (a -> ST s ()) -> (a -> a) -> a -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f
{-# INLINE updateSTRef #-}

-- | Abbreviation for reading an STRef.
rref :: STRef s a -> ST s a
rref :: STRef s a -> ST s a
rref = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef
{-# INLINE rref #-}

-- | Abbreviation for writing an STRef.
wref :: STRef s a -> a -> ST s ()
wref :: STRef s a -> a -> ST s ()
wref = STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef
{-# INLINE wref #-}

-- | Abbreviation for updating an STRef.
uref :: STRef s a -> (a -> a) -> ST s ()
uref :: STRef s a -> (a -> a) -> ST s ()
uref = STRef s a -> (a -> a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
updateSTRef
{-# INLINE uref #-}

-- | Finds the element in a list that is the succeessor of the element
--   matching a predicate.
findSucc :: (a -> Bool) -> [a] -> Maybe a
findSucc :: (a -> Bool) -> [a] -> Maybe a
findSucc a -> Bool
p [] = Maybe a
forall a. Maybe a
Nothing
findSucc a -> Bool
p (a
y:a
x:[a]
xs) = if a -> Bool
p a
y then a -> Maybe a
forall a. a -> Maybe a
Just a
x else (a -> Bool) -> [a] -> Maybe a
forall a. (a -> Bool) -> [a] -> Maybe a
findSucc a -> Bool
p (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
findSucc a -> Bool
p (a
x:[a]
xs) = (a -> Bool) -> [a] -> Maybe a
forall a. (a -> Bool) -> [a] -> Maybe a
findSucc a -> Bool
p [a]
xs

-- | Inserts an element in a list before the element satisfied by a predicate.
insertBefore :: (a -> Bool) -> a -> [a] -> [a]
insertBefore :: (a -> Bool) -> a -> [a] -> [a]
insertBefore a -> Bool
f a
_ [] = []
insertBefore a -> Bool
f a
x (a
y:[a]
ys) = if a -> Bool
f a
y then a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys else a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> a -> [a] -> [a]
forall a. (a -> Bool) -> a -> [a] -> [a]
insertBefore a -> Bool
f a
x [a]
ys

-- | Removes the first item from a list that satisfies a predicate.
removeFirst :: (a -> Bool) -> [a] -> [a]
removeFirst :: (a -> Bool) -> [a] -> [a]
removeFirst a -> Bool
p [] = []
removeFirst a -> Bool
p (a
x:[a]
xs) = if a -> Bool
p a
x then [a]
xs else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
removeFirst a -> Bool
p [a]
xs

-- | Extracts a range of text bewteen two delimiters.
textExtract :: Text -> Text -> Text -> Maybe Text
textExtract :: Text -> Text -> Text -> Maybe Text
textExtract Text
d0 Text
d1 Text
t
  | Text -> Bool
T.null Text
b = Maybe Text
forall a. Maybe a
Nothing
  | Text -> Bool
T.null Text
y = Maybe Text
forall a. Maybe a
Nothing
  | Text -> Bool
T.null Text
x = Maybe Text
forall a. Maybe a
Nothing
  | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
  where
    (Text
a,Text
b) = Text -> Text -> (Text, Text)
T.breakOn Text
d0 Text
t
    (Text
x,Text
y) = Text -> Text -> (Text, Text)
T.breakOn Text
d1 (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
d0) Text
b

-- | Returns a blank text of the specified length.
textBlank :: Int -> Text
textBlank :: Int -> Text
textBlank Int
x = Int -> Text -> Text
T.replicate Int
x (Char -> Text
T.singleton Char
' ')

-- | Converts a decimal string to a integer.
textReadDec :: Text -> Maybe Int
textReadDec :: Text -> Maybe Int
textReadDec Text
x =
  case ReadS Int
forall a. (Eq a, Num a) => ReadS a
N.readDec (Text -> String
T.unpack Text
x) of
    [(Int
a,String
_)]    -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
a
    [(Int, String)]
_otherwise -> Maybe Int
forall a. Maybe a
Nothing