{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | promoted String functions

module Predicate.Data.String (
  -- ** functions

    TrimBoth
  , TrimL
  , TrimR
  , StripR
  , StripL

  , IsPrefixC
  , IsInfixC
  , IsSuffixC
  , IsPrefixCI
  , IsInfixCI
  , IsSuffixCI

  , ToString
  , ToStringC (..)
  , FromString
  , FromString'
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import qualified GHC.TypeLits as GL
import Control.Lens
import Data.List (dropWhileEnd)
import qualified Data.Text.Lens as DTL
import Data.Proxy (Proxy(Proxy))
import Data.Kind (Type)
import Data.String (IsString(..))
import Data.Char (isSpace, toLower)
import Data.Function (on)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Control.Arrow (second)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import qualified Data.Text as T

-- >>> import Predicate.Prelude

-- >>> import qualified Data.Sequence as Seq


data TrimImpl (left :: Bool) (right :: Bool) deriving Int -> TrimImpl left right -> ShowS
[TrimImpl left right] -> ShowS
TrimImpl left right -> String
(Int -> TrimImpl left right -> ShowS)
-> (TrimImpl left right -> String)
-> ([TrimImpl left right] -> ShowS)
-> Show (TrimImpl left right)
forall (left :: Bool) (right :: Bool).
Int -> TrimImpl left right -> ShowS
forall (left :: Bool) (right :: Bool).
[TrimImpl left right] -> ShowS
forall (left :: Bool) (right :: Bool).
TrimImpl left right -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrimImpl left right] -> ShowS
$cshowList :: forall (left :: Bool) (right :: Bool).
[TrimImpl left right] -> ShowS
show :: TrimImpl left right -> String
$cshow :: forall (left :: Bool) (right :: Bool).
TrimImpl left right -> String
showsPrec :: Int -> TrimImpl left right -> ShowS
$cshowsPrec :: forall (left :: Bool) (right :: Bool).
Int -> TrimImpl left right -> ShowS
Show

instance ( FailUnlessT (OrT l r)
            ('GL.Text "TrimImpl: left and right cannot both be False")
         , GetBool l
         , GetBool r
         , DTL.IsText x
         ) => P (TrimImpl l r) x where
  type PP (TrimImpl l r) x = x
  eval :: proxy (TrimImpl l r) -> POpts -> x -> m (TT (PP (TrimImpl l r) x))
eval proxy (TrimImpl l r)
_ POpts
opts x
x =
    let msg0 :: String
msg0 = String
"Trim" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
l Bool -> Bool -> Bool
&& Bool
r then String
"Both" else if Bool
l then String
"L" else String
"R")
        l :: Bool
l = GetBool l => Bool
forall (a :: Bool). GetBool a => Bool
getBool @l
        r :: Bool
r = GetBool r => Bool
forall (a :: Bool). GetBool a => Bool
getBool @r
        p :: String
p = Getting String x String -> x -> String
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting String x String
forall t. IsText t => Iso' t String
DTL.unpacked x
x
        fl :: ShowS
fl = if Bool
l then (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace else ShowS
forall a. a -> a
id
        fr :: ShowS
fr = if Bool
r then (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace else ShowS
forall a. a -> a
id
        b :: String
b =  (ShowS
fl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
fr) String
p
     in TT x -> m (TT x)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT x -> m (TT x)) -> TT x -> m (TT x)
forall a b. (a -> b) -> a -> b
$ POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (x -> Val x
forall a. a -> Val a
Val (String
b String -> Getting x String x -> x
forall s a. s -> Getting a s a -> a
^. Getting x String x
forall t. IsText t => Iso' String t
DTL.packed)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | " String
p) []

-- | similar to 'Data.Text.stripStart'

--

-- >>> pz @(Snd >> TrimL) (20," abc   ")

-- Val "abc   "

--

data TrimL deriving Int -> TrimL -> ShowS
[TrimL] -> ShowS
TrimL -> String
(Int -> TrimL -> ShowS)
-> (TrimL -> String) -> ([TrimL] -> ShowS) -> Show TrimL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrimL] -> ShowS
$cshowList :: [TrimL] -> ShowS
show :: TrimL -> String
$cshow :: TrimL -> String
showsPrec :: Int -> TrimL -> ShowS
$cshowsPrec :: Int -> TrimL -> ShowS
Show
type TrimLT = TrimImpl 'True 'False

instance P TrimLT x => P TrimL x where
  type PP TrimL x = PP TrimLT x
  eval :: proxy TrimL -> POpts -> x -> m (TT (PP TrimL x))
eval proxy TrimL
_ = Proxy TrimLT -> POpts -> x -> m (TT (PP TrimLT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy TrimLT
forall k (t :: k). Proxy t
Proxy @TrimLT)

-- | similar to 'Data.Text.stripEnd'

--

-- >>> pz @(Snd >> TrimR) (20," abc   ")

-- Val " abc"

--

-- >>> pz @("  abc " >> TrimR) ()

-- Val "  abc"

--

-- >>> pz @("" >> TrimR) ()

-- Val ""

--

data TrimR deriving Int -> TrimR -> ShowS
[TrimR] -> ShowS
TrimR -> String
(Int -> TrimR -> ShowS)
-> (TrimR -> String) -> ([TrimR] -> ShowS) -> Show TrimR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrimR] -> ShowS
$cshowList :: [TrimR] -> ShowS
show :: TrimR -> String
$cshow :: TrimR -> String
showsPrec :: Int -> TrimR -> ShowS
$cshowsPrec :: Int -> TrimR -> ShowS
Show
type TrimRT = TrimImpl 'False 'True

instance P TrimRT x => P TrimR x where
  type PP TrimR x = PP TrimRT x
  eval :: proxy TrimR -> POpts -> x -> m (TT (PP TrimR x))
eval proxy TrimR
_ = Proxy TrimRT -> POpts -> x -> m (TT (PP TrimRT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy TrimRT
forall k (t :: k). Proxy t
Proxy @TrimRT)

-- | similar to 'Data.Text.strip'

--

-- >>> pz @(Snd >> TrimBoth) (20," abc   ")

-- Val "abc"

--

-- >>> pz @(Snd >> TrimBoth) (20,T.pack " abc   ")

-- Val "abc"

--

-- >>> pz @("         " >> TrimBoth) ()

-- Val ""

--

-- >>> pz @("" >> TrimBoth) ()

-- Val ""

--

data TrimBoth deriving Int -> TrimBoth -> ShowS
[TrimBoth] -> ShowS
TrimBoth -> String
(Int -> TrimBoth -> ShowS)
-> (TrimBoth -> String) -> ([TrimBoth] -> ShowS) -> Show TrimBoth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrimBoth] -> ShowS
$cshowList :: [TrimBoth] -> ShowS
show :: TrimBoth -> String
$cshow :: TrimBoth -> String
showsPrec :: Int -> TrimBoth -> ShowS
$cshowsPrec :: Int -> TrimBoth -> ShowS
Show
type TrimBothT = TrimImpl 'True 'True

instance P TrimBothT x => P TrimBoth x where
  type PP TrimBoth x = PP TrimBothT x
  eval :: proxy TrimBoth -> POpts -> x -> m (TT (PP TrimBoth x))
eval proxy TrimBoth
_ = Proxy TrimBothT -> POpts -> x -> m (TT (PP TrimBothT x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy TrimBothT
forall k (t :: k). Proxy t
Proxy @TrimBothT)

data StripImpl(left :: Bool) p q deriving Int -> StripImpl left p q -> ShowS
[StripImpl left p q] -> ShowS
StripImpl left p q -> String
(Int -> StripImpl left p q -> ShowS)
-> (StripImpl left p q -> String)
-> ([StripImpl left p q] -> ShowS)
-> Show (StripImpl left p q)
forall (left :: Bool) k (p :: k) k (q :: k).
Int -> StripImpl left p q -> ShowS
forall (left :: Bool) k (p :: k) k (q :: k).
[StripImpl left p q] -> ShowS
forall (left :: Bool) k (p :: k) k (q :: k).
StripImpl left p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StripImpl left p q] -> ShowS
$cshowList :: forall (left :: Bool) k (p :: k) k (q :: k).
[StripImpl left p q] -> ShowS
show :: StripImpl left p q -> String
$cshow :: forall (left :: Bool) k (p :: k) k (q :: k).
StripImpl left p q -> String
showsPrec :: Int -> StripImpl left p q -> ShowS
$cshowsPrec :: forall (left :: Bool) k (p :: k) k (q :: k).
Int -> StripImpl left p q -> ShowS
Show

instance ( GetBool l
         , PP p x ~ String
         , P p x
         , DTL.IsText (PP q x)
         , P q x
         ) => P (StripImpl l p q) x where
  type PP (StripImpl l p q) x = Maybe (PP q x)
  eval :: proxy (StripImpl l p q)
-> POpts -> x -> m (TT (PP (StripImpl l p q) x))
eval proxy (StripImpl l p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Strip" String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool
l then String
"L" else String
"R"
        l :: Bool
l = GetBool l => Bool
forall (a :: Bool). GetBool a => Bool
getBool @l
    Either
  (TT (Maybe (PP q x))) (String, PP q x, TT String, TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (Maybe (PP q x))) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT (Maybe (PP q x)) -> m (TT (Maybe (PP q x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe (PP q x)) -> m (TT (Maybe (PP q x))))
-> TT (Maybe (PP q x)) -> m (TT (Maybe (PP q x)))
forall a b. (a -> b) -> a -> b
$ case Either
  (TT (Maybe (PP q x))) (String, PP q x, TT String, TT (PP q x))
lr of
      Left TT (Maybe (PP q x))
e -> TT (Maybe (PP q x))
e
      Right (String
p,Getting String (PP q x) String -> PP q x -> String
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting String (PP q x) String
forall t. IsText t => Iso' t String
DTL.unpacked -> String
q,TT String
pp,TT (PP q x)
qq) ->
        let b :: Maybe String
b = if Bool
l then
                  let (String
before,String
after) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
p) String
q
                  in if String
before String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p then String -> Maybe String
forall a. a -> Maybe a
Just String
after else Maybe String
forall a. Maybe a
Nothing
                else
                  let (String
before,String
after) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
q Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
p) String
q
                  in if String
after String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p then String -> Maybe String
forall a. a -> Maybe a
Just String
before else Maybe String
forall a. Maybe a
Nothing
        in POpts
-> Val (Maybe (PP q x))
-> String
-> [Tree PE]
-> TT (Maybe (PP q x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (PP q x) -> Val (Maybe (PP q x))
forall a. a -> Val a
Val ((String -> PP q x) -> Maybe String -> Maybe (PP q x)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting (PP q x) String (PP q x) -> String -> PP q x
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (PP q x) String (PP q x)
forall t. IsText t => Iso' String t
DTL.packed) Maybe String
b)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Maybe String -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Maybe String
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | p=" String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | q=" String
q) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]

-- | similar to 'Data.Text.stripLeft'

--

-- >>> pz @(StripL "xyz" Id) "xyzHello"

-- Val (Just "Hello")

--

-- >>> pz @(StripL "xyz" Id) (T.pack "xyzHello")

-- Val (Just "Hello")

--

-- >>> pz @(StripL "xyz" Id) "xywHello"

-- Val Nothing

--

data StripL p q deriving Int -> StripL p q -> ShowS
[StripL p q] -> ShowS
StripL p q -> String
(Int -> StripL p q -> ShowS)
-> (StripL p q -> String)
-> ([StripL p q] -> ShowS)
-> Show (StripL p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> StripL p q -> ShowS
forall k (p :: k) k (q :: k). [StripL p q] -> ShowS
forall k (p :: k) k (q :: k). StripL p q -> String
showList :: [StripL p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [StripL p q] -> ShowS
show :: StripL p q -> String
$cshow :: forall k (p :: k) k (q :: k). StripL p q -> String
showsPrec :: Int -> StripL p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> StripL p q -> ShowS
Show
type StripLT p q = StripImpl 'True p q

instance P (StripLT p q) x => P (StripL p q) x where
  type PP (StripL p q) x = PP (StripLT p q) x
  eval :: proxy (StripL p q) -> POpts -> x -> m (TT (PP (StripL p q) x))
eval proxy (StripL p q)
_ = Proxy (StripLT p q) -> POpts -> x -> m (TT (PP (StripLT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StripLT p q)
forall k (t :: k). Proxy t
Proxy @(StripLT p q))

-- | similar to 'Data.Text.stripRight'

--

-- >>> pz @(StripR "xyz" Id) "Hello xyz"

-- Val (Just "Hello ")

--

-- >>> pz @(StripR "xyz" Id) "xyzHelloxyw"

-- Val Nothing

--

-- >>> pz @(StripR "xyz" Id) ""

-- Val Nothing

--

-- >>> pz @(StripR "xyz" "xyz") ()

-- Val (Just "")

--

data StripR p q deriving Int -> StripR p q -> ShowS
[StripR p q] -> ShowS
StripR p q -> String
(Int -> StripR p q -> ShowS)
-> (StripR p q -> String)
-> ([StripR p q] -> ShowS)
-> Show (StripR p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> StripR p q -> ShowS
forall k (p :: k) k (q :: k). [StripR p q] -> ShowS
forall k (p :: k) k (q :: k). StripR p q -> String
showList :: [StripR p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [StripR p q] -> ShowS
show :: StripR p q -> String
$cshow :: forall k (p :: k) k (q :: k). StripR p q -> String
showsPrec :: Int -> StripR p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> StripR p q -> ShowS
Show
type StripRT p q = StripImpl 'False p q

instance P (StripRT p q) x => P (StripR p q) x where
  type PP (StripR p q) x = PP (StripRT p q) x
  eval :: proxy (StripR p q) -> POpts -> x -> m (TT (PP (StripR p q) x))
eval proxy (StripR p q)
_ = Proxy (StripRT p q) -> POpts -> x -> m (TT (PP (StripRT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StripRT p q)
forall k (t :: k). Proxy t
Proxy @(StripRT p q))

data IsFixImplC (cmp :: Ordering) (ignore :: Bool) p q deriving Int -> IsFixImplC cmp ignore p q -> ShowS
[IsFixImplC cmp ignore p q] -> ShowS
IsFixImplC cmp ignore p q -> String
(Int -> IsFixImplC cmp ignore p q -> ShowS)
-> (IsFixImplC cmp ignore p q -> String)
-> ([IsFixImplC cmp ignore p q] -> ShowS)
-> Show (IsFixImplC cmp ignore p q)
forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
Int -> IsFixImplC cmp ignore p q -> ShowS
forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
[IsFixImplC cmp ignore p q] -> ShowS
forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
IsFixImplC cmp ignore p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsFixImplC cmp ignore p q] -> ShowS
$cshowList :: forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
[IsFixImplC cmp ignore p q] -> ShowS
show :: IsFixImplC cmp ignore p q -> String
$cshow :: forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
IsFixImplC cmp ignore p q -> String
showsPrec :: Int -> IsFixImplC cmp ignore p q -> ShowS
$cshowsPrec :: forall (cmp :: Ordering) (ignore :: Bool) k (p :: k) k (q :: k).
Int -> IsFixImplC cmp ignore p q -> ShowS
Show

instance ( GetBool ignore
         , P p x
         , P q x
         , PP p x ~ String
         , PP q x ~ String
         , GetOrdering cmp
         ) => P (IsFixImplC cmp ignore p q) x where
  type PP (IsFixImplC cmp ignore p q) x = Bool
  eval :: proxy (IsFixImplC cmp ignore p q)
-> POpts -> x -> m (TT (PP (IsFixImplC cmp ignore p q) x))
eval proxy (IsFixImplC cmp ignore p q)
_ POpts
opts x
x = do
    let cmp :: Ordering
cmp = GetOrdering cmp => Ordering
forall (cmp :: Ordering). GetOrdering cmp => Ordering
getOrdering @cmp
        ignore :: Bool
ignore = GetBool ignore => Bool
forall (a :: Bool). GetBool a => Bool
getBool @ignore
        lwr :: ShowS
lwr = if Bool
ignore then (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower else ShowS
forall a. a -> a
id
        (String -> String -> Bool
ff,String
msg0) = ShowS
-> (String -> String -> Bool, String)
-> (String -> String -> Bool, String)
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"C") ((String -> String -> Bool, String)
 -> (String -> String -> Bool, String))
-> (String -> String -> Bool, String)
-> (String -> String -> Bool, String)
forall a b. (a -> b) -> a -> b
$ Ordering -> (String -> String -> Bool, String)
forall a. Eq a => Ordering -> ([a] -> [a] -> Bool, String)
cmpOf Ordering
cmp
    Either (TT Bool) (String, String, TT String, TT String)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT Bool) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (String, String, TT String, TT String)
lr of
      Left TT Bool
e -> TT Bool
e
      Right (String
p',String
q',TT String
pp,TT String
qq) ->
        let hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
qq]
        in case POpts
-> String
-> String
-> String
-> [Tree PE]
-> Either (TT Bool) ((Int, String), (Int, String))
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String
-> t a
-> u b
-> [Tree PE]
-> Either (TT x) ((Int, [a]), (Int, [b]))
chkSize2 POpts
opts String
msg0 String
p' String
q' [Tree PE]
hhs of
          Left TT Bool
e -> TT Bool
e
          Right ((Int
_,String
p),(Int
_,String
q)) ->
            let msg1 :: String
msg1 = String -> ShowS
joinStrings (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> if Bool
ignore then String
"I" else String
"") String
p
            in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts ((String -> String -> Bool) -> ShowS -> String -> String -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on String -> String -> Bool
ff ShowS
lwr String
p String
q) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
q) [Tree PE]
hhs

-- | similar to 'Data.List.isPrefixOf' for strings

--

-- >>> pl @(IsPrefixC "xy" Id) "xyzabw"

-- True (IsPrefixC | xy xyzabw)

-- Val True

--

-- >>> pl @(IsPrefixC "ab" Id) "xyzbaw"

-- False (IsPrefixC | ab xyzbaw)

-- Val False

--

-- >>> pz @(IsPrefixC "abc" "aBcbCd") ()

-- Val False

--

data IsPrefixC p q deriving Int -> IsPrefixC p q -> ShowS
[IsPrefixC p q] -> ShowS
IsPrefixC p q -> String
(Int -> IsPrefixC p q -> ShowS)
-> (IsPrefixC p q -> String)
-> ([IsPrefixC p q] -> ShowS)
-> Show (IsPrefixC p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsPrefixC p q -> ShowS
forall k (p :: k) k (q :: k). [IsPrefixC p q] -> ShowS
forall k (p :: k) k (q :: k). IsPrefixC p q -> String
showList :: [IsPrefixC p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsPrefixC p q] -> ShowS
show :: IsPrefixC p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsPrefixC p q -> String
showsPrec :: Int -> IsPrefixC p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsPrefixC p q -> ShowS
Show
type IsPrefixCT p q = IsFixImplC 'LT 'False p q

instance P (IsPrefixCT p q) x => P (IsPrefixC p q) x where
  type PP (IsPrefixC p q) x = PP (IsPrefixCT p q) x
  eval :: proxy (IsPrefixC p q)
-> POpts -> x -> m (TT (PP (IsPrefixC p q) x))
eval proxy (IsPrefixC p q)
_ = Proxy (IsPrefixCT p q)
-> POpts -> x -> m (TT (PP (IsPrefixCT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsPrefixCT p q)
forall k (t :: k). Proxy t
Proxy @(IsPrefixCT p q))

-- | similar to 'Data.List.isInfixOf' for strings

--

-- >>> pl @(IsInfixC "ab" Id) "xyzabw"

-- True (IsInfixC | ab xyzabw)

-- Val True

--

-- >>> pl @(IsInfixC "aB" Id) "xyzAbw"

-- False (IsInfixC | aB xyzAbw)

-- Val False

--

-- >>> pl @(IsInfixC "ab" Id) "xyzbaw"

-- False (IsInfixC | ab xyzbaw)

-- Val False

--

-- >>> pl @(IsInfixC Fst Snd) ("ab","xyzabw")

-- True (IsInfixC | ab xyzabw)

-- Val True

--

data IsInfixC p q deriving Int -> IsInfixC p q -> ShowS
[IsInfixC p q] -> ShowS
IsInfixC p q -> String
(Int -> IsInfixC p q -> ShowS)
-> (IsInfixC p q -> String)
-> ([IsInfixC p q] -> ShowS)
-> Show (IsInfixC p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsInfixC p q -> ShowS
forall k (p :: k) k (q :: k). [IsInfixC p q] -> ShowS
forall k (p :: k) k (q :: k). IsInfixC p q -> String
showList :: [IsInfixC p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsInfixC p q] -> ShowS
show :: IsInfixC p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsInfixC p q -> String
showsPrec :: Int -> IsInfixC p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsInfixC p q -> ShowS
Show
type IsInfixCT p q = IsFixImplC 'EQ 'False p q

instance P (IsInfixCT p q) x => P (IsInfixC p q) x where
  type PP (IsInfixC p q) x = PP (IsInfixCT p q) x
  eval :: proxy (IsInfixC p q) -> POpts -> x -> m (TT (PP (IsInfixC p q) x))
eval proxy (IsInfixC p q)
_ = Proxy (IsInfixCT p q)
-> POpts -> x -> m (TT (PP (IsInfixCT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsInfixCT p q)
forall k (t :: k). Proxy t
Proxy @(IsInfixCT p q))

-- | similar to 'Data.List.isSuffixOf' for strings

--

-- >>> pl @(IsSuffixC "bw" Id) "xyzabw"

-- True (IsSuffixC | bw xyzabw)

-- Val True

--

-- >>> pl @(IsSuffixC "bw" Id) "xyzbaw"

-- False (IsSuffixC | bw xyzbaw)

-- Val False

--

-- >>> pz @(IsSuffixC "bCd" "aBcbCd") ()

-- Val True

--

data IsSuffixC p q deriving Int -> IsSuffixC p q -> ShowS
[IsSuffixC p q] -> ShowS
IsSuffixC p q -> String
(Int -> IsSuffixC p q -> ShowS)
-> (IsSuffixC p q -> String)
-> ([IsSuffixC p q] -> ShowS)
-> Show (IsSuffixC p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsSuffixC p q -> ShowS
forall k (p :: k) k (q :: k). [IsSuffixC p q] -> ShowS
forall k (p :: k) k (q :: k). IsSuffixC p q -> String
showList :: [IsSuffixC p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsSuffixC p q] -> ShowS
show :: IsSuffixC p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsSuffixC p q -> String
showsPrec :: Int -> IsSuffixC p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsSuffixC p q -> ShowS
Show
type IsSuffixCT p q = IsFixImplC 'GT 'False p q

instance P (IsSuffixCT p q) x => P (IsSuffixC p q) x where
  type PP (IsSuffixC p q) x = PP (IsSuffixCT p q) x
  eval :: proxy (IsSuffixC p q)
-> POpts -> x -> m (TT (PP (IsSuffixC p q) x))
eval proxy (IsSuffixC p q)
_ = Proxy (IsSuffixCT p q)
-> POpts -> x -> m (TT (PP (IsSuffixCT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsSuffixCT p q)
forall k (t :: k). Proxy t
Proxy @(IsSuffixCT p q))

-- | similar to case insensitive 'Data.List.isPrefixOf' for strings

--

-- >>> pz @(IsPrefixCI "abc" "aBcbCd") ()

-- Val True

--

data IsPrefixCI p q deriving Int -> IsPrefixCI p q -> ShowS
[IsPrefixCI p q] -> ShowS
IsPrefixCI p q -> String
(Int -> IsPrefixCI p q -> ShowS)
-> (IsPrefixCI p q -> String)
-> ([IsPrefixCI p q] -> ShowS)
-> Show (IsPrefixCI p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsPrefixCI p q -> ShowS
forall k (p :: k) k (q :: k). [IsPrefixCI p q] -> ShowS
forall k (p :: k) k (q :: k). IsPrefixCI p q -> String
showList :: [IsPrefixCI p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsPrefixCI p q] -> ShowS
show :: IsPrefixCI p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsPrefixCI p q -> String
showsPrec :: Int -> IsPrefixCI p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsPrefixCI p q -> ShowS
Show
type IsPrefixCIT p q = IsFixImplC 'LT 'True p q

instance P (IsPrefixCIT p q) x => P (IsPrefixCI p q) x where
  type PP (IsPrefixCI p q) x = PP (IsPrefixCIT p q) x
  eval :: proxy (IsPrefixCI p q)
-> POpts -> x -> m (TT (PP (IsPrefixCI p q) x))
eval proxy (IsPrefixCI p q)
_ = Proxy (IsPrefixCIT p q)
-> POpts -> x -> m (TT (PP (IsPrefixCIT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsPrefixCIT p q)
forall k (t :: k). Proxy t
Proxy @(IsPrefixCIT p q))

-- | similar to case insensitive 'Data.List.isInfixOf' for strings

--

-- >>> pl @(IsInfixCI "aB" Id) "xyzAbw"

-- True (IsInfixCI | aB xyzAbw)

-- Val True

--

-- >>> pz @(IsInfixCI "abc" "axAbCd") ()

-- Val True

--

data IsInfixCI p q deriving Int -> IsInfixCI p q -> ShowS
[IsInfixCI p q] -> ShowS
IsInfixCI p q -> String
(Int -> IsInfixCI p q -> ShowS)
-> (IsInfixCI p q -> String)
-> ([IsInfixCI p q] -> ShowS)
-> Show (IsInfixCI p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsInfixCI p q -> ShowS
forall k (p :: k) k (q :: k). [IsInfixCI p q] -> ShowS
forall k (p :: k) k (q :: k). IsInfixCI p q -> String
showList :: [IsInfixCI p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsInfixCI p q] -> ShowS
show :: IsInfixCI p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsInfixCI p q -> String
showsPrec :: Int -> IsInfixCI p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsInfixCI p q -> ShowS
Show
type IsInfixCIT p q = IsFixImplC 'EQ 'True p q

instance P (IsInfixCIT p q) x => P (IsInfixCI p q) x where
  type PP (IsInfixCI p q) x = PP (IsInfixCIT p q) x
  eval :: proxy (IsInfixCI p q)
-> POpts -> x -> m (TT (PP (IsInfixCI p q) x))
eval proxy (IsInfixCI p q)
_ = Proxy (IsInfixCIT p q)
-> POpts -> x -> m (TT (PP (IsInfixCIT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsInfixCIT p q)
forall k (t :: k). Proxy t
Proxy @(IsInfixCIT p q))

-- | similar to case insensitive 'Data.List.isSuffixOf' for strings

--

data IsSuffixCI p q deriving Int -> IsSuffixCI p q -> ShowS
[IsSuffixCI p q] -> ShowS
IsSuffixCI p q -> String
(Int -> IsSuffixCI p q -> ShowS)
-> (IsSuffixCI p q -> String)
-> ([IsSuffixCI p q] -> ShowS)
-> Show (IsSuffixCI p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsSuffixCI p q -> ShowS
forall k (p :: k) k (q :: k). [IsSuffixCI p q] -> ShowS
forall k (p :: k) k (q :: k). IsSuffixCI p q -> String
showList :: [IsSuffixCI p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsSuffixCI p q] -> ShowS
show :: IsSuffixCI p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsSuffixCI p q -> String
showsPrec :: Int -> IsSuffixCI p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsSuffixCI p q -> ShowS
Show
type IsSuffixCIT p q = IsFixImplC 'GT 'True p q

instance P (IsSuffixCIT p q) x => P (IsSuffixCI p q) x where
  type PP (IsSuffixCI p q) x = PP (IsSuffixCIT p q) x
  eval :: proxy (IsSuffixCI p q)
-> POpts -> x -> m (TT (PP (IsSuffixCI p q) x))
eval proxy (IsSuffixCI p q)
_ = Proxy (IsSuffixCIT p q)
-> POpts -> x -> m (TT (PP (IsSuffixCIT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (IsSuffixCIT p q)
forall k (t :: k). Proxy t
Proxy @(IsSuffixCIT p q))

-- | very simple conversion to a string

data ToString deriving Int -> ToString -> ShowS
[ToString] -> ShowS
ToString -> String
(Int -> ToString -> ShowS)
-> (ToString -> String) -> ([ToString] -> ShowS) -> Show ToString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToString] -> ShowS
$cshowList :: [ToString] -> ShowS
show :: ToString -> String
$cshow :: ToString -> String
showsPrec :: Int -> ToString -> ShowS
$cshowsPrec :: Int -> ToString -> ShowS
Show
instance ToStringC x => P ToString x where
  type PP ToString x = String
  eval :: proxy ToString -> POpts -> x -> m (TT (PP ToString x))
eval proxy ToString
_ POpts
opts x
x = TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val (x -> String
forall a. ToStringC a => a -> String
toStringC x
x)) String
"ToString" []

class ToStringC (a :: Type) where
  toStringC :: a -> String
instance ToStringC String where
  toStringC :: ShowS
toStringC = ShowS
forall a. a -> a
id
instance ToStringC T.Text where
  toStringC :: Text -> String
toStringC = Text -> String
T.unpack
instance ToStringC TL.Text where
  toStringC :: Text -> String
toStringC = Text -> String
TL.unpack
instance ToStringC BL8.ByteString where
  toStringC :: ByteString -> String
toStringC = ByteString -> String
BL8.unpack
instance ToStringC BS8.ByteString where
  toStringC :: ByteString -> String
toStringC = ByteString -> String
BS8.unpack

-- | 'fromString' function where you need to provide a reference to the type @t@ of the result

data FromString' t p deriving Int -> FromString' t p -> ShowS
[FromString' t p] -> ShowS
FromString' t p -> String
(Int -> FromString' t p -> ShowS)
-> (FromString' t p -> String)
-> ([FromString' t p] -> ShowS)
-> Show (FromString' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> FromString' t p -> ShowS
forall k (t :: k) k (p :: k). [FromString' t p] -> ShowS
forall k (t :: k) k (p :: k). FromString' t p -> String
showList :: [FromString' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [FromString' t p] -> ShowS
show :: FromString' t p -> String
$cshow :: forall k (t :: k) k (p :: k). FromString' t p -> String
showsPrec :: Int -> FromString' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> FromString' t p -> ShowS
Show

instance ( P p a
         , PP p a ~ String
         , Show (PP t a)
         , IsString (PP t a)
         ) => P (FromString' t p) a where
  type PP (FromString' t p) a = PP t a
  eval :: proxy (FromString' t p)
-> POpts -> a -> m (TT (PP (FromString' t p) a))
eval proxy (FromString' t p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"FromString"
    TT String
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t a)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (PP t a)
e -> TT (PP t a)
e
      Right String
p ->
        let b :: PP t a
b = String -> PP t a
forall a. IsString a => String -> a
fromString @(PP t a) String
p
        in POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP t a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t a
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | 'fromString' function where you need to provide the type @t@ of the result

--

-- >>> pz @(FromString (Identity _) Id) "abc"

-- Val (Identity "abc")

--

-- >>> pz @(FromString (Seq.Seq Char) Id) "abc"

-- Val (fromList "abc")

--

data FromString (t :: Type) p deriving Int -> FromString t p -> ShowS
[FromString t p] -> ShowS
FromString t p -> String
(Int -> FromString t p -> ShowS)
-> (FromString t p -> String)
-> ([FromString t p] -> ShowS)
-> Show (FromString t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> FromString t p -> ShowS
forall t k (p :: k). [FromString t p] -> ShowS
forall t k (p :: k). FromString t p -> String
showList :: [FromString t p] -> ShowS
$cshowList :: forall t k (p :: k). [FromString t p] -> ShowS
show :: FromString t p -> String
$cshow :: forall t k (p :: k). FromString t p -> String
showsPrec :: Int -> FromString t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> FromString t p -> ShowS
Show
type FromStringT (t :: Type) p = FromString' (Hole t) p

instance P (FromStringT t p) x => P (FromString t p) x where
  type PP (FromString t p) x = PP (FromStringT t p) x
  eval :: proxy (FromString t p)
-> POpts -> x -> m (TT (PP (FromString t p) x))
eval proxy (FromString t p)
_ = Proxy (FromStringT t p)
-> POpts -> x -> m (TT (PP (FromStringT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FromStringT t p)
forall k (t :: k). Proxy t
Proxy @(FromStringT t p))