module System.Process.Quick.Predicate.Regex where

import System.Process.Quick.Predicate
import System.Process.Quick.Prelude
import System.Process.Quick.Sbv.Arbitrary
import System.Process.Quick.TdfaToSbvRegex as P
import Text.Regex.TDFA ((=~))


data Regex (p :: Symbol) = Regex deriving ((forall x. Regex p -> Rep (Regex p) x)
-> (forall x. Rep (Regex p) x -> Regex p) -> Generic (Regex p)
forall x. Rep (Regex p) x -> Regex p
forall x. Regex p -> Rep (Regex p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: Symbol) x. Rep (Regex p) x -> Regex p
forall (p :: Symbol) x. Regex p -> Rep (Regex p) x
$cfrom :: forall (p :: Symbol) x. Regex p -> Rep (Regex p) x
from :: forall x. Regex p -> Rep (Regex p) x
$cto :: forall (p :: Symbol) x. Rep (Regex p) x -> Regex p
to :: forall x. Rep (Regex p) x -> Regex p
Generic)

instance KnownSymbol s => Predicate (Regex s) String where
  validate :: Proxy (Regex s) -> String -> Maybe RefineException
validate Proxy (Regex s)
p String
x =
    let rx :: String
rx = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s) in
      if String
x String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
rx
      then Maybe RefineException
forall a. Maybe a
Nothing
      else TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (Proxy (Regex s) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy (Regex s)
p) (Text -> Maybe RefineException) -> Text -> Maybe RefineException
forall a b. (a -> b) -> a -> b
$ Text
"Regex " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall b a. (Show a, IsString b) => a -> b
show String
rx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" mismatches [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

instance {-# OVERLAPPING #-}
  KnownSymbol p => Arbitrary (Refined (Regex p) String) where

  arbitrary :: Gen (Refined (Regex p) String)
arbitrary =
    let rx :: String
rx = Proxy p -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @p) in do
      String -> Refined (Regex p) String
forall {k} (p :: k) a. (Predicate p a, Show a) => a -> Refined p a
refinErr (String -> Refined (Regex p) String)
-> Gen String -> Gen (Refined (Regex p) String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegExp -> Gen String
forall b. SymVal b => RegExp -> Gen b
findStringByRegex (String -> RegExp
parse String
rx)

type FsPath = Regex "^([/~]|(~[/]|[/])?[^/\x0000-\x001F]+([/][^/\x0000-\x001F]+)*[/]?)$"
type FsPath2 = Regex "^([/~]|(~[/]|[/])?[a-zA-Z0-9._ -]+([/][a-zA-Z0-9._ -]+)*[/]?)$"