{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
module Text.Regex.PCRE.Rex
(
rex, brex
, rexWithConf, RexConf(..), defaultRexConf
, makeQuasiMultiline
, eitherToParseResult
, parseExp
, parsePat
, rexParseMode
, rexView
) where
import Text.Regex.PCRE.Precompile
import qualified Text.Regex.PCRE.Light as PCRE
import Control.Applicative ( (<$>) )
import Control.Arrow ( first )
import Data.ByteString.Char8 ( ByteString, pack, unpack, empty )
import Data.Either ( partitionEithers )
import Data.Maybe ( catMaybes )
import Data.Char ( isSpace )
import System.IO.Unsafe ( unsafePerformIO )
import Language.Haskell.TH (Body(..), Dec(..), Exp(..), ExpQ, Pat(..), PatQ, Lit(..),
mkName, newName, runIO)
import Language.Haskell.TH.Quote
import Language.Haskell.Meta (toExp,toPat)
import Language.Haskell.Exts.Extension (Extension(..), KnownExtension(..))
import Language.Haskell.Exts (parseExpWithMode, parsePatWithMode,
ParseMode, defaultParseMode, extensions,
ParseResult(..))
import Language.Haskell.Exts.SrcLoc (noLoc)
data RexConf = RexConf {
RexConf -> Bool
rexByteString :: Bool,
RexConf -> Bool
rexCompiled :: Bool,
RexConf -> String -> String
rexPreprocessExp :: String -> String,
RexConf -> String -> String
rexPreprocessPat :: String -> String,
RexConf -> Exp
rexViewExp :: Exp,
RexConf -> [PCREOption]
rexPCREOpts :: [PCRE.PCREOption],
RexConf -> [PCREExecOption]
rexPCREExecOpts :: [PCRE.PCREExecOption]
}
defaultRexConf :: RexConf
defaultRexConf :: RexConf
defaultRexConf = RexConf :: Bool
-> Bool
-> (String -> String)
-> (String -> String)
-> Exp
-> [PCREOption]
-> [PCREExecOption]
-> RexConf
RexConf
{ rexByteString :: Bool
rexByteString = Bool
False
, rexCompiled :: Bool
rexCompiled = Bool
True
, rexPreprocessExp :: String -> String
rexPreprocessExp = \String
s -> if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s then String
"rexView" else String
s
, rexPreprocessPat :: String -> String
rexPreprocessPat = \String
s -> String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
, rexViewExp :: Exp
rexViewExp = Name -> Exp
VarE (String -> Name
mkName String
"rexView")
, rexPCREOpts :: [PCREOption]
rexPCREOpts = [PCREOption
PCRE.extended]
, rexPCREExecOpts :: [PCREExecOption]
rexPCREExecOpts = []
}
rex :: QuasiQuoter
rex :: QuasiQuoter
rex = RexConf -> QuasiQuoter
rexWithConf RexConf
defaultRexConf
brex :: QuasiQuoter
brex :: QuasiQuoter
brex = RexConf -> QuasiQuoter
rexWithConf RexConf
defaultRexConf { rexByteString :: Bool
rexByteString = Bool
True }
makeQuasiMultiline :: QuasiQuoter -> QuasiQuoter
makeQuasiMultiline :: QuasiQuoter -> QuasiQuoter
makeQuasiMultiline (QuasiQuoter String -> Q Exp
a String -> Q Pat
b String -> Q Type
c String -> Q [Dec]
d) =
(String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter (String -> Q Exp
a (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pre) (String -> Q Pat
b (String -> Q Pat) -> (String -> String) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pre) (String -> Q Type
c (String -> Q Type) -> (String -> String) -> String -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pre) (String -> Q [Dec]
d (String -> Q [Dec]) -> (String -> String) -> String -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pre)
where
pre :: String -> String
pre = [String] -> String
removeLineSpaces ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
removeLineSpaces :: [String] -> String
removeLineSpaces [] = []
removeLineSpaces (String
x:[String]
xs) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) [String]
xs
rexWithConf :: RexConf -> QuasiQuoter
rexWithConf :: RexConf -> QuasiQuoter
rexWithConf RexConf
conf =
(String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
(RexConf -> ParseChunks -> Q Exp
makeExp RexConf
conf (ParseChunks -> Q Exp)
-> (String -> ParseChunks) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChunks
parseRex)
(RexConf -> ParseChunks -> Q Pat
makePat RexConf
conf (ParseChunks -> Q Pat)
-> (String -> ParseChunks) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseChunks
parseRex)
String -> Q Type
forall a. HasCallStack => a
undefined
String -> Q [Dec]
forall a. HasCallStack => a
undefined
makeExp :: RexConf -> ParseChunks -> ExpQ
makeExp :: RexConf -> ParseChunks -> Q Exp
makeExp RexConf
conf (Int
cnt, String
pat, [Maybe String]
exs) =
RexConf -> Int -> String -> [Maybe Exp] -> Q Exp
buildExp RexConf
conf Int
cnt String
pat ([Maybe Exp] -> Q Exp) -> [Maybe Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ((Maybe String -> Maybe Exp) -> [Maybe String] -> [Maybe Exp])
-> [Maybe String] -> (Maybe String -> Maybe Exp) -> [Maybe Exp]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe String -> Maybe Exp) -> [Maybe String] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map [Maybe String]
exs ((Maybe String -> Maybe Exp) -> [Maybe Exp])
-> (Maybe String -> Maybe Exp) -> [Maybe Exp]
forall a b. (a -> b) -> a -> b
$ (String -> Exp) -> Maybe String -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Exp) -> Maybe String -> Maybe Exp)
-> (String -> Exp) -> Maybe String -> Maybe Exp
forall a b. (a -> b) -> a -> b
$
String -> ParseResult Exp -> Exp
forall a. Show a => String -> ParseResult a -> a
fromParseOk String
"While parsing expression antiquote"
(ParseResult Exp -> Exp)
-> (String -> ParseResult Exp) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseResult Exp
parseExp
(String -> ParseResult Exp)
-> (String -> String) -> String -> ParseResult Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RexConf -> String -> String
rexPreprocessExp RexConf
conf
makePat :: RexConf -> ParseChunks -> PatQ
makePat :: RexConf -> ParseChunks -> Q Pat
makePat RexConf
conf (Int
cnt, String
pat, [Maybe String]
exs) = do
Exp
viewExp <- RexConf -> Int -> String -> [Maybe Exp] -> Q Exp
buildExp RexConf
conf Int
cnt String
pat ([Maybe Exp] -> Q Exp) -> [Maybe Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Maybe (Exp, Pat) -> Maybe Exp)
-> [Maybe (Exp, Pat)] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map (((Exp, Pat) -> Exp) -> Maybe (Exp, Pat) -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp, Pat) -> Exp
forall a b. (a, b) -> a
fst) [Maybe (Exp, Pat)]
views
Pat -> Q Pat
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat -> Q Pat) -> ([(Exp, Pat)] -> Pat) -> [(Exp, Pat)] -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Pat -> Pat
ViewP Exp
viewExp
(Pat -> Pat) -> ([(Exp, Pat)] -> Pat) -> [(Exp, Pat)] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Pat]
xs -> Name -> [Pat] -> Pat
ConP 'Just
#if MIN_VERSION_template_haskell(2,18,0)
[]
#endif
[[Pat] -> Pat
TupP [Pat]
xs]
)
([Pat] -> Pat) -> ([(Exp, Pat)] -> [Pat]) -> [(Exp, Pat)] -> Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Exp, Pat) -> Pat) -> [(Exp, Pat)] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map (Exp, Pat) -> Pat
forall a b. (a, b) -> b
snd ([(Exp, Pat)] -> Q Pat) -> [(Exp, Pat)] -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Maybe (Exp, Pat)] -> [(Exp, Pat)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Exp, Pat)]
views
where
views :: [Maybe (Exp, Pat)]
views :: [Maybe (Exp, Pat)]
views = (Maybe String -> Maybe (Exp, Pat))
-> [Maybe String] -> [Maybe (Exp, Pat)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> (Exp, Pat)) -> Maybe String -> Maybe (Exp, Pat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> (Exp, Pat)
processView) [Maybe String]
exs
processView :: String -> (Exp, Pat)
processView :: String -> (Exp, Pat)
processView String
xs = case String -> ParseResult Pat
parsePat (RexConf -> String -> String
rexPreprocessPat RexConf
conf String
xs) of
ParseOk (ParensP (ViewP Exp
e Pat
p)) -> (Exp
e,Pat
p)
ParseOk Pat
p -> (RexConf -> Exp
rexViewExp RexConf
conf, Pat
p)
ParseFailed SrcLoc
_ String
b -> String -> (Exp, Pat)
forall a. HasCallStack => String -> a
error String
b
buildExp :: RexConf -> Int -> String -> [Maybe Exp] -> ExpQ
buildExp :: RexConf -> Int -> String -> [Maybe Exp] -> Q Exp
buildExp RexConf{Bool
[PCREOption]
[PCREExecOption]
Exp
String -> String
rexPCREExecOpts :: [PCREExecOption]
rexPCREOpts :: [PCREOption]
rexViewExp :: Exp
rexPreprocessPat :: String -> String
rexPreprocessExp :: String -> String
rexCompiled :: Bool
rexByteString :: Bool
rexPCREExecOpts :: RexConf -> [PCREExecOption]
rexPCREOpts :: RexConf -> [PCREOption]
rexViewExp :: RexConf -> Exp
rexPreprocessPat :: RexConf -> String -> String
rexPreprocessExp :: RexConf -> String -> String
rexCompiled :: RexConf -> Bool
rexByteString :: RexConf -> Bool
..} Int
cnt String
pat [Maybe Exp]
xs =
[| let r = $(get_regex) in
$(process) . (flip $ PCRE.match r) $(liftRS rexPCREExecOpts)
. $(if rexByteString then [| id |] else [| pack |]) |]
where
liftRS :: a -> Q Exp
liftRS a
x = [| read shown |] where shown :: String
shown = a -> String
forall a. Show a => a -> String
show a
x
get_regex :: Q Exp
get_regex
| Bool
rexCompiled = [| unsafePerformIO (regexFromTable $! $(table_bytes)) |]
| Bool
otherwise = [| PCRE.compile (pack pat) $(liftRS pcreOpts) |]
table_bytes :: Q Exp
table_bytes = [| pack $(LitE . StringL . unpack <$> runIO table_string) |]
table_string :: IO CompiledBytes
table_string =
String -> Maybe CompiledBytes -> CompiledBytes
forall a. String -> Maybe a -> a
fromJust' String
"Error while getting PCRE compiled representation\n" (Maybe CompiledBytes -> CompiledBytes)
-> IO (Maybe CompiledBytes) -> IO CompiledBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
CompiledBytes -> [PCREOption] -> IO (Maybe CompiledBytes)
precompile (String -> CompiledBytes
pack String
pat) [PCREOption]
pcreOpts
pcreOpts :: [PCREOption]
pcreOpts = [PCREOption]
rexPCREOpts
process :: Q Exp
process = case ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
vs, Bool
rexByteString) of
(Bool
True, Bool
_) -> [| fmap ( const () ) |]
(Bool
_, Bool
False) -> [| fmap ($(maps 'unconsStr)) |]
(Bool
_, Bool
True) -> [| fmap ($(maps 'unconsByte)) |]
maps :: Name -> Q Exp
maps Name
def = do
Name
vsName <- String -> Q Name
newName String
"vs"
[Dec]
lets <- Name -> [Pat] -> Q [Dec]
makeLets Name
vsName ([Pat] -> Q [Dec]) -> ([Pat] -> [Pat]) -> [Pat] -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pat
WildPPat -> [Pat] -> [Pat]
forall a. a -> [a] -> [a]
:) ([Pat] -> Q [Dec]) -> [Pat] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ (Name -> Pat) -> [Name] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP [Name]
vs
Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
vsName] (Exp -> Exp) -> ([Exp] -> Exp) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dec] -> Exp -> Exp
LetE [Dec]
lets
(Exp -> Exp) -> ([Exp] -> Exp) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Exp] -> Exp
TupE
#if MIN_VERSION_template_haskell(2,16,0)
([Maybe Exp] -> Exp) -> ([Exp] -> [Maybe Exp]) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#endif
([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp -> Exp -> Exp
AppE Exp
x (Name -> Exp
VarE Name
v) | (Just Exp
x, Name
v) <- [Maybe Exp] -> [Name] -> [(Maybe Exp, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe Exp]
xs [Name]
vs]
where
makeLets :: Name -> [Pat] -> Q [Dec]
makeLets Name
_ [] = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return []
makeLets Name
vsName (Pat
y:[Pat]
ys)
| [Pat] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pat]
ys = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Pat -> Dec
makeLet Pat
WildP]
| Bool
otherwise = do
Name
innerVsName <- String -> Q Name
newName String
"vs"
let yLet :: Dec
yLet = Pat -> Dec
makeLet (Name -> Pat
VarP Name
innerVsName)
[Dec]
yLets <- Name -> [Pat] -> Q [Dec]
makeLets Name
innerVsName [Pat]
ys
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Dec
yLetDec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:[Dec]
yLets
where
makeLet :: Pat -> Dec
makeLet Pat
innerVs = Pat -> Body -> [Dec] -> Dec
ValD ([Pat] -> Pat
TupP [Pat
y,Pat
innerVs]) (Exp -> Body
NormalB (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE Name
def) (Name -> Exp
VarE Name
vsName))) []
vs :: [Name]
vs = [String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"v" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [Int
0..Int
cnt]]
eitherToParseResult :: Either String a -> ParseResult a
eitherToParseResult :: Either String a -> ParseResult a
eitherToParseResult (Left String
err) = SrcLoc -> String -> ParseResult a
forall a. SrcLoc -> String -> ParseResult a
ParseFailed SrcLoc
noLoc String
err
eitherToParseResult (Right a
x) = a -> ParseResult a
forall a. a -> ParseResult a
ParseOk a
x
parseExp :: String -> ParseResult Exp
parseExp :: String -> ParseResult Exp
parseExp = (Exp SrcSpanInfo -> Exp)
-> ParseResult (Exp SrcSpanInfo) -> ParseResult Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp SrcSpanInfo -> Exp
forall a. ToExp a => a -> Exp
toExp (ParseResult (Exp SrcSpanInfo) -> ParseResult Exp)
-> (String -> ParseResult (Exp SrcSpanInfo))
-> String
-> ParseResult Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode ParseMode
rexParseMode
parsePat :: String -> ParseResult Pat
parsePat :: String -> ParseResult Pat
parsePat = (Pat SrcSpanInfo -> Pat)
-> ParseResult (Pat SrcSpanInfo) -> ParseResult Pat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat SrcSpanInfo -> Pat
forall a. ToPat a => a -> Pat
toPat (ParseResult (Pat SrcSpanInfo) -> ParseResult Pat)
-> (String -> ParseResult (Pat SrcSpanInfo))
-> String
-> ParseResult Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Pat SrcSpanInfo)
parsePatWithMode ParseMode
rexParseMode
rexParseMode :: ParseMode
rexParseMode :: ParseMode
rexParseMode = ParseMode
defaultParseMode { extensions :: [Extension]
extensions = (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension [KnownExtension]
exts }
where
exts :: [KnownExtension]
exts =
[ KnownExtension
ViewPatterns
, KnownExtension
ImplicitParams
, KnownExtension
RecordPuns
, KnownExtension
RecordWildCards
, KnownExtension
ScopedTypeVariables
, KnownExtension
TupleSections
, KnownExtension
TypeFamilies
, KnownExtension
TypeOperators
]
type ParseChunk = Either String (Maybe String)
type ParseChunks = (Int, String, [Maybe String])
parseRex :: String -> ParseChunks
parseRex :: String -> ParseChunks
parseRex String
xs = (Int
cnt, [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
chunks, [Maybe String]
quotes)
where
([String]
chunks, [Maybe String]
quotes) = [Either String (Maybe String)] -> ([String], [Maybe String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String (Maybe String)]
results
(Int
cnt, [Either String (Maybe String)]
results) = String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"\r\n") String
xs) String
"" (-Int
1)
parseRegex :: String -> String -> Int -> (Int, [ParseChunk])
parseRegex :: String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
inp String
s Int
ix = case String
inp of
(Char
'(':Char
'?':Char
'|':String
_) ->
String -> (Int, [Either String (Maybe String)])
forall a. HasCallStack => String -> a
error String
"Branch reset pattern (?| not allowed in quasi-quoted regex."
(Char
'\\':Char
'\\' :String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (String
"\\\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) Int
ix
(Char
'\\':Char
'(' :String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (String
")\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) Int
ix
(Char
'\\':Char
')' :String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (String
"(\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) Int
ix
(Char
'(':Char
'?':Char
':':String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (String
":?(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) Int
ix
(Char
'(':Char
'?':Char
'{':String
xs) -> ([Either String (Maybe String)] -> [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall t t2 t1. (t -> t2) -> (t1, t) -> (t1, t2)
mapSnd ((String -> Either String (Maybe String)
forall a b. a -> Either a b
Left (String -> Either String (Maybe String))
-> String -> Either String (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String
s)) Either String (Maybe String)
-> [Either String (Maybe String)] -> [Either String (Maybe String)]
forall a. a -> [a] -> [a]
:)
((Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)]))
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> (Int, [Either String (Maybe String)])
parseAntiquote String
xs String
"" (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
(Char
'(':String
xs) -> ([Either String (Maybe String)] -> [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall t t2 t1. (t -> t2) -> (t1, t) -> (t1, t2)
mapSnd (Maybe String -> Either String (Maybe String)
forall a b. b -> Either a b
Right Maybe String
forall a. Maybe a
Nothing Either String (Maybe String)
-> [Either String (Maybe String)] -> [Either String (Maybe String)]
forall a. a -> [a] -> [a]
:)
((Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)]))
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String
s) (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
(Char
x:String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
s) Int
ix
[] -> (Int
ix, [String -> Either String (Maybe String)
forall a b. a -> Either a b
Left (String -> Either String (Maybe String))
-> String -> Either String (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
s])
parseAntiquote :: String -> String -> Int -> (Int, [ParseChunk])
parseAntiquote :: String -> String -> Int -> (Int, [Either String (Maybe String)])
parseAntiquote String
inp String
s Int
ix = case String
inp of
(Char
'\\':Char
'}':String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseAntiquote String
xs (Char
'}'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s) Int
ix
(Char
'}':String
xs) -> ([Either String (Maybe String)] -> [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall t t2 t1. (t -> t2) -> (t1, t) -> (t1, t2)
mapSnd ((Maybe String -> Either String (Maybe String)
forall a b. b -> Either a b
Right (String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse String
s)))Either String (Maybe String)
-> [Either String (Maybe String)] -> [Either String (Maybe String)]
forall a. a -> [a] -> [a]
:)
((Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)]))
-> (Int, [Either String (Maybe String)])
-> (Int, [Either String (Maybe String)])
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> (Int, [Either String (Maybe String)])
parseRegex String
xs String
"" Int
ix
(Char
x:String
xs) -> String -> String -> Int -> (Int, [Either String (Maybe String)])
parseAntiquote String
xs (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
s) Int
ix
[] -> String -> (Int, [Either String (Maybe String)])
forall a. HasCallStack => String -> a
error String
"Rex haskell splice terminator, }, never found"
unconsStr :: [ByteString] -> (String,[ByteString])
unconsStr :: [CompiledBytes] -> (String, [CompiledBytes])
unconsStr [] = (String
"",[])
unconsStr (CompiledBytes
x:[CompiledBytes]
xs) = (CompiledBytes -> String
unpack CompiledBytes
x,[CompiledBytes]
xs)
unconsByte :: [ByteString] -> (ByteString,[ByteString])
unconsByte :: [CompiledBytes] -> (CompiledBytes, [CompiledBytes])
unconsByte [] = (CompiledBytes
empty,[])
unconsByte (CompiledBytes
x:[CompiledBytes]
xs) = (CompiledBytes
x,[CompiledBytes]
xs)
rexView :: a -> a
rexView :: a -> a
rexView = a -> a
forall a. a -> a
id
mapSnd :: (t -> t2) -> (t1, t) -> (t1, t2)
mapSnd :: (t -> t2) -> (t1, t) -> (t1, t2)
mapSnd t -> t2
f (t1
x, t
y) = (t1
x, t -> t2
f t
y)
fromJust' :: String -> Maybe a -> a
fromJust' :: String -> Maybe a -> a
fromJust' String
msg Maybe a
Nothing = String -> a
forall a. HasCallStack => String -> a
error String
msg
fromJust' String
_ (Just a
x) = a
x
fromParseOk :: Show a => String -> ParseResult a -> a
fromParseOk :: String -> ParseResult a -> a
fromParseOk String
_ (ParseOk a
x) = a
x
fromParseOk String
msg ParseResult a
err = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseResult a -> String
forall a. Show a => a -> String
show ParseResult a
err