{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module Clash.Util.Interpolate (i, format, toString) where
import Language.Haskell.Meta.Parse (parseExp)
import Language.Haskell.TH.Lib (appE, varE)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Language.Haskell.TH.Syntax (Q, Exp)
import qualified Numeric as N
import Data.Char
(isHexDigit, chr, isOctDigit, isDigit, isSpace)
import Data.Maybe (fromMaybe, isJust, catMaybes)
import Text.Read (readMaybe)
data Line
= EmptyLine
| ExprLine Indent String
| Line Indent [Node]
deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> [Char]
(Int -> Line -> ShowS)
-> (Line -> [Char]) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Line -> ShowS
showsPrec :: Int -> Line -> ShowS
$cshow :: Line -> [Char]
show :: Line -> [Char]
$cshowList :: [Line] -> ShowS
showList :: [Line] -> ShowS
Show)
data Node
= Literal String
| Expression String
deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> [Char]
(Int -> Node -> ShowS)
-> (Node -> [Char]) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> [Char]
show :: Node -> [Char]
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show)
type Indent = Int
format :: [Node] -> String
format :: [Node] -> [Char]
format = ShowS
stripWhiteSpace ShowS -> ([Node] -> [Char]) -> [Node] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Char]
showLines ([Line] -> [Char]) -> ([Node] -> [Line]) -> [Node] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Line]
nodesToLines
where
go :: Int -> ShowS
go Int
_ [] = []
go Int
n (Char
c:[Char]
cs) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = Int -> ShowS
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
cs
go Int
0 (Char
c:[Char]
cs) = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
go Int
0 [Char]
cs
go Int
n [Char]
cs = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
n Char
' ' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> ShowS
go Int
0 [Char]
cs)
stripWhiteSpace :: ShowS
stripWhiteSpace = Int -> ShowS
go Int
0 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
showLines :: [Line] -> String
showLines :: [Line] -> [Char]
showLines [] = [Char]
""
showLines [Line]
ns = ShowS
forall a. HasCallStack => [a] -> [a]
init ((Line -> [Char]) -> [Line] -> [Char]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Line -> [Char]
showLine [Line]
ns)
where
showLine :: Line -> String
showLine :: Line -> [Char]
showLine Line
EmptyLine = [Char]
"\n"
showLine (Line Int
n [Node]
ns') =
let theIndent :: [Char]
theIndent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
commonIndent) Char
' ' in
[Char]
theIndent [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Node -> [Char]) -> [Node] -> [Char]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Node -> [Char]
nodeToString [Node]
ns') [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
showLine (ExprLine Int
n [Char]
s) =
let theIndent :: [Char]
theIndent = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
commonIndent) Char
' ' in
[[Char]] -> [Char]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[Char]
theIndent [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" | [Char]
l <- [Char] -> [[Char]]
lines [Char]
s]
nodeToString :: Node -> String
nodeToString :: Node -> [Char]
nodeToString (Literal [Char]
s) = [Char]
s
nodeToString (Expression [Char]
s) = [Char]
s
commonIndent :: Indent
commonIndent :: Int
commonIndent = (Int -> Int -> Int) -> [Int] -> Int
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldl1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
min ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ((Line -> Maybe Int) -> [Line] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Maybe Int
indent [Line]
ns))
indent :: Line -> Maybe Indent
indent :: Line -> Maybe Int
indent Line
EmptyLine = Maybe Int
forall a. Maybe a
Nothing
indent (ExprLine Int
n [Char]
_) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
indent (Line Int
n [Node]
_) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
nodesToLines :: [Node] -> [Line]
nodesToLines :: [Node] -> [Line]
nodesToLines =
(Line -> [Line]) -> [Line] -> [Line]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Line -> [Line]
splitLines
([Line] -> [Line]) -> ([Node] -> [Line]) -> [Node] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Line]
mergeLines
([Line] -> [Line]) -> ([Node] -> [Line]) -> [Node] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Line]
dropEmpty
([Line] -> [Line]) -> ([Node] -> [Line]) -> [Node] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Line) -> [Line] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map Line -> Line
splitWords
([Line] -> [Line]) -> ([Node] -> [Line]) -> [Node] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> Line) -> [[Node]] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map [Node] -> Line
toLine
([[Node]] -> [Line]) -> ([Node] -> [[Node]]) -> [Node] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> [Node]) -> [[Node]] -> [[Node]]
forall a b. (a -> b) -> [a] -> [b]
map [Node] -> [Node]
dropTrailingEmpty
([[Node]] -> [[Node]])
-> ([Node] -> [[Node]]) -> [Node] -> [[Node]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node] -> [[Node]]
collectLines []
([Node] -> [[Node]]) -> ([Node] -> [Node]) -> [Node] -> [[Node]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
joinLiterals
where
emptyLit :: Node -> Maybe Int
emptyLit (Literal [Char]
s) =
if (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
s then
Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
s)
else
Maybe Int
forall a. Maybe a
Nothing
emptyLit Node
_ = Maybe Int
forall a. Maybe a
Nothing
isEmptyLine :: Line -> Bool
isEmptyLine Line
EmptyLine = Bool
True
isEmptyLine Line
_ = Bool
False
dropEmpty :: [Line] -> [Line]
dropEmpty = [Line] -> [Line]
forall a. [a] -> [a]
reverse ([Line] -> [Line]) -> ([Line] -> [Line]) -> [Line] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Line -> Bool
isEmptyLine ([Line] -> [Line]) -> ([Line] -> [Line]) -> [Line] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Line] -> [Line]
forall a. [a] -> [a]
reverse ([Line] -> [Line]) -> ([Line] -> [Line]) -> [Line] -> [Line]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line -> Bool) -> [Line] -> [Line]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Line -> Bool
isEmptyLine
dropTrailingEmpty :: [Node] -> [Node]
dropTrailingEmpty = [Node] -> [Node]
forall a. [a] -> [a]
reverse ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Bool) -> [Node] -> [Node]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Node -> Maybe Int) -> Node -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Maybe Int
emptyLit) ([Node] -> [Node]) -> ([Node] -> [Node]) -> [Node] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
forall a. [a] -> [a]
reverse
splitLines :: Line -> [Line]
splitLines :: Line -> [Line]
splitLines Line
EmptyLine = [Line
EmptyLine]
splitLines e :: Line
e@(ExprLine {}) = [Line
e]
splitLines (Line Int
n [Node]
nodes) = ([Node] -> Line) -> [[Node]] -> [Line]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Node] -> Line
Line Int
n) (Int -> [Node] -> [Node] -> [[Node]]
go Int
0 [] [Node]
nodes)
where
maxLength :: Int
maxLength = Int
80
go :: Int -> [Node] -> [Node] -> [[Node]]
go :: Int -> [Node] -> [Node] -> [[Node]]
go Int
accLen [Node]
acc [Node]
goNodes | Int
accLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLength = [Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
acc [Node] -> [[Node]] -> [[Node]]
forall a. a -> [a] -> [a]
: Int -> [Node] -> [Node] -> [[Node]]
go Int
0 [] [Node]
goNodes
go Int
accLen [Node]
acc (l :: Node
l@(Literal [Char]
s):[Node]
goNodes) = Int -> [Node] -> [Node] -> [[Node]]
go (Int
accLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
s) (Node
lNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
acc) [Node]
goNodes
go Int
accLen [Node]
acc (e :: Node
e@(Expression [Char]
s):[Node]
goNodes) = Int -> [Node] -> [Node] -> [[Node]]
go (Int
accLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
s) (Node
eNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
acc) [Node]
goNodes
go Int
_accLen [Node]
acc [] = [[Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
acc]
mergeLines :: [Line] -> [Line]
mergeLines :: [Line] -> [Line]
mergeLines (l0 :: Line
l0@(Line Int
n0 [Node]
nodes0):l1 :: Line
l1@(Line Int
n1 [Node]
nodes1):[Line]
ls) =
if Int
n0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n1 then
[Line] -> [Line]
mergeLines (Int -> [Node] -> Line
Line Int
n0 ([Node]
nodes0 [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [[Char] -> Node
Literal [Char]
" "] [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node]
nodes1) Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
ls)
else
Line
l0Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:[Line] -> [Line]
mergeLines (Line
l1Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:[Line]
ls)
mergeLines (Line
l:[Line]
ls) = Line
lLine -> [Line] -> [Line]
forall a. a -> [a] -> [a]
:[Line] -> [Line]
mergeLines [Line]
ls
mergeLines [] = []
splitWords :: Line -> Line
splitWords :: Line -> Line
splitWords Line
EmptyLine = Line
EmptyLine
splitWords e :: Line
e@(ExprLine {})= Line
e
splitWords (Line Int
n [Node]
nodes) = Int -> [Node] -> Line
Line Int
n ((Node -> [Node]) -> [Node] -> [Node]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Node -> [Node]
go [Node]
nodes)
where
go :: Node -> [Node]
go (Expression [Char]
s) = [[Char] -> Node
Expression [Char]
s]
go (Literal [Char]
"") = []
go (Literal [Char]
s0) =
let
pre :: [Char]
pre = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ')) [Char]
s0
post :: [Char]
post = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) [Char]
s0
in case [Char]
post of
[] -> [[Char] -> Node
Literal [Char]
s0]
(Char
_:[Char]
s1) -> [Char] -> Node
Literal ([Char]
pre [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" ") Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: Node -> [Node]
go ([Char] -> Node
Literal [Char]
s1)
toLine :: [Node] -> Line
toLine = \case
[] -> Line
EmptyLine
[Node -> Maybe Int
emptyLit -> Just Int
_] -> Line
EmptyLine
[Expression [Char]
s] -> Int -> [Char] -> Line
ExprLine Int
0 [Char]
s
[Node -> Maybe Int
emptyLit -> Just Int
n, Expression [Char]
s] -> Int -> [Char] -> Line
ExprLine Int
n [Char]
s
ns :: [Node]
ns@(Expression [Char]
_:[Node]
_) -> Int -> [Node] -> Line
Line Int
0 [Node]
ns
(Literal [Char]
s:[Node]
ns) ->
Int -> [Node] -> Line
Line
([Char] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
s))
([Char] -> Node
Literal ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') [Char]
s)Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
ns)
collectLines :: [Node] -> [Node] -> [[Node]]
collectLines [Node]
collected [Node]
todo =
case ([Node]
collected, [Node]
todo) of
([], []) -> []
([Node]
_, []) -> [[Node] -> [Node]
forall a. [a] -> [a]
reverse [Node]
collected]
([Node]
_, s :: Node
s@(Expression [Char]
_):[Node]
ns) ->
[Node] -> [Node] -> [[Node]]
collectLines (Node
sNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
collected) [Node]
ns
([Node]
_, Literal [Char]
s0:[Node]
ns) ->
let
pre :: [Char]
pre = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') [Char]
s0
post :: [Char]
post = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') [Char]
s0
in case [Char]
post of
[] ->
[Node] -> [Node] -> [[Node]]
collectLines ([Char] -> Node
Literal [Char]
s0Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
collected) [Node]
ns
(Char
_:[Char]
s1) ->
[Node] -> [Node]
forall a. [a] -> [a]
reverse ([Char] -> Node
Literal [Char]
preNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
collected) [Node] -> [[Node]] -> [[Node]]
forall a. a -> [a] -> [a]
: [Node] -> [Node] -> [[Node]]
collectLines [] ([Char] -> Node
Literal [Char]
s1Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
ns)
joinLiterals :: [Node] -> [Node]
joinLiterals :: [Node] -> [Node]
joinLiterals [] = []
joinLiterals (Literal [Char]
s0:Literal [Char]
s1:[Node]
ss) = [Node] -> [Node]
joinLiterals ([Char] -> Node
Literal ([Char]
s0 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s1)Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node]
ss)
joinLiterals (Node
n:[Node]
ns) = Node
nNode -> [Node] -> [Node]
forall a. a -> [a] -> [a]
:[Node] -> [Node]
joinLiterals [Node]
ns
i :: QuasiQuoter
i :: QuasiQuoter
i = QuasiQuoter {
quoteExp :: [Char] -> Q Exp
quoteExp = (Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE 'format `appE`) (Q Exp -> Q Exp) -> ([Char] -> Q Exp) -> [Char] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Q Exp
toExp ([Node] -> Q Exp) -> ([Char] -> [Node]) -> [Char] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Node]
parseNodes ([Char] -> [Node]) -> ShowS -> [Char] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
decodeNewlines
, quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall {a}. [Char] -> a
err [Char]
"pattern"
, quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall {a}. [Char] -> a
err [Char]
"type"
, quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall {a}. [Char] -> a
err [Char]
"declaration"
}
where
err :: [Char] -> a
err [Char]
name =
[Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Clash.Util.Interpolate.i: This QuasiQuoter can not be used as a "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"!")
toExp:: [Node] -> Q Exp
toExp :: [Node] -> Q Exp
toExp [Node]
nodes = case [Node]
nodes of
[] -> [|[]|]
(Node
x:[Node]
xs) -> Node -> Q Exp
f Node
x Q Exp -> Q Exp -> Q Exp
forall (m :: Type -> Type). Quote m => m Exp -> m Exp -> m Exp
`appE` [Node] -> Q Exp
toExp [Node]
xs
where
f :: Node -> Q Exp
f (Literal [Char]
s) = [|(Literal s:)|]
f (Expression [Char]
e) = [|(Expression (toString ($([Char] -> Q Exp
reifyExpression [Char]
e))):)|]
reifyExpression :: String -> Q Exp
reifyExpression :: [Char] -> Q Exp
reifyExpression [Char]
s = case [Char] -> Either [Char] Exp
parseExp [Char]
s of
Left [Char]
_ -> do
[Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char]
"Parse error in expression: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s) :: Q Exp
Right Exp
e -> Exp -> Q Exp
forall a. a -> Q a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Exp
e
parseNodes :: String -> [Node]
parseNodes :: [Char] -> [Node]
parseNodes = [Char] -> [Char] -> [Node]
go [Char]
""
where
go :: String -> String -> [Node]
go :: [Char] -> [Char] -> [Node]
go [Char]
acc [Char]
input = case [Char]
input of
[Char]
"" -> [([Char] -> Node
lit ([Char] -> Node) -> ShowS -> [Char] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) [Char]
acc]
Char
'\\':Char
x:[Char]
xs -> [Char] -> [Char] -> [Node]
go (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
xs
Char
'#':Char
'{':[Char]
xs -> [Char] -> [Char] -> [Char] -> [Char] -> [Node]
goExpr [Char]
input [Char]
acc [] [Char]
xs
Char
x:[Char]
xs -> [Char] -> [Char] -> [Node]
go (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
acc) [Char]
xs
goExpr :: [Char] -> [Char] -> [Char] -> [Char] -> [Node]
goExpr [Char]
input [Char]
accLit [Char]
accExpr [Char]
xs = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\') [Char]
xs of
([Char]
ys, Char
'}' :[Char]
zs) -> ([Char] -> Node
lit ([Char] -> Node) -> ShowS -> [Char] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) [Char]
accLit Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Char] -> Node
Expression (ShowS
forall a. [a] -> [a]
reverse [Char]
accExpr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ys) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Char] -> [Char] -> [Node]
go [Char]
"" [Char]
zs
([Char]
ys, Char
'\\':Char
'}':[Char]
zs) -> [Char] -> [Char] -> [Char] -> [Char] -> [Node]
goExpr [Char]
input [Char]
accLit (Char
'}' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
forall a. [a] -> [a]
reverse [Char]
ys [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
accExpr) [Char]
zs
([Char]
ys, Char
'\\':[Char]
zs) -> [Char] -> [Char] -> [Char] -> [Char] -> [Node]
goExpr [Char]
input [Char]
accLit (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
forall a. [a] -> [a]
reverse [Char]
ys [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
accExpr) [Char]
zs
([Char]
_, [Char]
"") -> [[Char] -> Node
lit (ShowS
forall a. [a] -> [a]
reverse [Char]
accLit [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
input)]
([Char], [Char])
_ -> [Char] -> [Node]
forall a. HasCallStack => [Char] -> a
error [Char]
"(impossible) parseError in parseNodes"
lit :: String -> Node
lit :: [Char] -> Node
lit = [Char] -> Node
Literal ([Char] -> Node) -> ShowS -> [Char] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
unescape
decodeNewlines :: String -> String
decodeNewlines :: ShowS
decodeNewlines = ShowS
go
where
go :: ShowS
go [Char]
xs = case [Char]
xs of
Char
'\r' : Char
'\n' : [Char]
ys -> Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
ys
Char
y : [Char]
ys -> Char
y Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
ys
[] -> []
toString :: Show a => a -> String
toString :: forall a. Show a => a -> [Char]
toString a
a = let s :: [Char]
s = a -> [Char]
forall a. Show a => a -> [Char]
show a
a in [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
s ([Char] -> Maybe [Char]
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s)
{-# NOINLINE toString #-}
{-# RULES "toString/String" toString = id #-}
{-# RULES "toString/Int" toString = show :: Int -> String #-}
{-# RULES "toString/Integer" toString = show :: Integer -> String #-}
{-# RULES "toString/Float" toString = show :: Float -> String #-}
{-# RULES "toString/Double" toString = show :: Double -> String #-}
unescape :: String -> String
unescape :: ShowS
unescape = ShowS
go
where
go :: ShowS
go [Char]
input = case [Char]
input of
[Char]
"" -> [Char]
""
Char
'\\' : Char
'x' : Char
x : [Char]
xs | Char -> Bool
isHexDigit Char
x -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isHexDigit [Char]
xs of
([Char]
ys, [Char]
zs) -> (Int -> Char
chr (Int -> Char) -> ([Char] -> Int) -> [Char] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
readHex ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ys) Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
zs
Char
'\\' : Char
'o' : Char
x : [Char]
xs | Char -> Bool
isOctDigit Char
x -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isOctDigit [Char]
xs of
([Char]
ys, [Char]
zs) -> (Int -> Char
chr (Int -> Char) -> ([Char] -> Int) -> [Char] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
readOct ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ys) Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
zs
Char
'\\' : Char
x : [Char]
xs | Char -> Bool
isDigit Char
x -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit [Char]
xs of
([Char]
ys, [Char]
zs) -> (Int -> Char
chr (Int -> Char) -> ([Char] -> Int) -> [Char] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ys) Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
zs
Char
'\\' : [Char]
input_ -> case [Char]
input_ of
Char
'\\' : [Char]
xs -> Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'a' : [Char]
xs -> Char
'\a' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'b' : [Char]
xs -> Char
'\b' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'f' : [Char]
xs -> Char
'\f' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'n' : [Char]
xs -> Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'r' : [Char]
xs -> Char
'\r' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
't' : [Char]
xs -> Char
'\t' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'v' : [Char]
xs -> Char
'\v' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'&' : [Char]
xs -> ShowS
go [Char]
xs
Char
'N':Char
'U':Char
'L' : [Char]
xs -> Char
'\NUL' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'O':Char
'H' : [Char]
xs -> Char
'\SOH' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'T':Char
'X' : [Char]
xs -> Char
'\STX' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'T':Char
'X' : [Char]
xs -> Char
'\ETX' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'O':Char
'T' : [Char]
xs -> Char
'\EOT' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'N':Char
'Q' : [Char]
xs -> Char
'\ENQ' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'A':Char
'C':Char
'K' : [Char]
xs -> Char
'\ACK' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'B':Char
'E':Char
'L' : [Char]
xs -> Char
'\BEL' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'B':Char
'S' : [Char]
xs -> Char
'\BS' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'H':Char
'T' : [Char]
xs -> Char
'\HT' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'L':Char
'F' : [Char]
xs -> Char
'\LF' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'V':Char
'T' : [Char]
xs -> Char
'\VT' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'F':Char
'F' : [Char]
xs -> Char
'\FF' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'C':Char
'R' : [Char]
xs -> Char
'\CR' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'O' : [Char]
xs -> Char
'\SO' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'I' : [Char]
xs -> Char
'\SI' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'L':Char
'E' : [Char]
xs -> Char
'\DLE' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'C':Char
'1' : [Char]
xs -> Char
'\DC1' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'C':Char
'2' : [Char]
xs -> Char
'\DC2' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'C':Char
'3' : [Char]
xs -> Char
'\DC3' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'C':Char
'4' : [Char]
xs -> Char
'\DC4' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'N':Char
'A':Char
'K' : [Char]
xs -> Char
'\NAK' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'Y':Char
'N' : [Char]
xs -> Char
'\SYN' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'T':Char
'B' : [Char]
xs -> Char
'\ETB' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'C':Char
'A':Char
'N' : [Char]
xs -> Char
'\CAN' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'M' : [Char]
xs -> Char
'\EM' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'U':Char
'B' : [Char]
xs -> Char
'\SUB' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'E':Char
'S':Char
'C' : [Char]
xs -> Char
'\ESC' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'F':Char
'S' : [Char]
xs -> Char
'\FS' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'G':Char
'S' : [Char]
xs -> Char
'\GS' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'R':Char
'S' : [Char]
xs -> Char
'\RS' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'U':Char
'S' : [Char]
xs -> Char
'\US' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'S':Char
'P' : [Char]
xs -> Char
'\SP' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'D':Char
'E':Char
'L' : [Char]
xs -> Char
'\DEL' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'@' : [Char]
xs -> Char
'\^@' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'A' : [Char]
xs -> Char
'\^A' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'B' : [Char]
xs -> Char
'\^B' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'C' : [Char]
xs -> Char
'\^C' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'D' : [Char]
xs -> Char
'\^D' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'E' : [Char]
xs -> Char
'\^E' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'F' : [Char]
xs -> Char
'\^F' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'G' : [Char]
xs -> Char
'\^G' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'H' : [Char]
xs -> Char
'\^H' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'I' : [Char]
xs -> Char
'\^I' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'J' : [Char]
xs -> Char
'\^J' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'K' : [Char]
xs -> Char
'\^K' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'L' : [Char]
xs -> Char
'\^L' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'M' : [Char]
xs -> Char
'\^M' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'N' : [Char]
xs -> Char
'\^N' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'O' : [Char]
xs -> Char
'\^O' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'P' : [Char]
xs -> Char
'\^P' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'Q' : [Char]
xs -> Char
'\^Q' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'R' : [Char]
xs -> Char
'\^R' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'S' : [Char]
xs -> Char
'\^S' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'T' : [Char]
xs -> Char
'\^T' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'U' : [Char]
xs -> Char
'\^U' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'V' : [Char]
xs -> Char
'\^V' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'W' : [Char]
xs -> Char
'\^W' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'X' : [Char]
xs -> Char
'\^X' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'Y' : [Char]
xs -> Char
'\^Y' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'Z' : [Char]
xs -> Char
'\^Z' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'[' : [Char]
xs -> Char
'\^[' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'\\' : [Char]
xs -> Char
'\^\' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
']' : [Char]
xs -> Char
'\^]' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'^' : [Char]
xs -> Char
'\^^' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
Char
'^':Char
'_' : [Char]
xs -> Char
'\^_' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
[Char]
xs -> ShowS
go [Char]
xs
Char
x:[Char]
xs -> Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go [Char]
xs
readHex :: String -> Int
readHex :: [Char] -> Int
readHex [Char]
xs = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
N.readHex [Char]
xs of
[(Int
n, [Char]
"")] -> Int
n
[(Int, [Char])]
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Name -> [Char]
forall a. Show a => a -> [Char]
show 'unescape) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" readHex: no parse"
readOct :: String -> Int
readOct :: [Char] -> Int
readOct [Char]
xs = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
N.readOct [Char]
xs of
[(Int
n, [Char]
"")] -> Int
n
[(Int, [Char])]
_ -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Name -> [Char]
forall a. Show a => a -> [Char]
show 'unescape) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" readOct: no parse"