{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Pretty.Simple.Internal.ExprParser
where
import Text.Pretty.Simple.Internal.Expr (CommaSeparated(..), Expr(..))
import Control.Arrow (first)
import Data.Char (isAlpha, isDigit)
testString1 :: String
testString1 :: String
testString1 = "Just [TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}, TextInput {textInputClass = Just (Class {unClass = \"class\"}), textInputId = Just (Id {unId = \"id\"}), textInputName = Just (Name {unName = \"name\"}), textInputValue = Just (Value {unValue = \"value\"}), textInputPlaceholder = Just (Placeholder {unPlaceholder = \"placeholder\"})}]"
testString2 :: String
testString2 :: String
testString2 = "some stuff (hello [\"dia\\x40iahello\", why wh, bye] ) (bye)"
expressionParse :: String -> [Expr]
expressionParse :: String -> [Expr]
expressionParse = ([Expr], String) -> [Expr]
forall a b. (a, b) -> a
fst (([Expr], String) -> [Expr])
-> (String -> ([Expr], String)) -> String -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ([Expr], String)
parseExprs
parseExpr :: String -> (Expr, String)
parseExpr :: String -> (Expr, String)
parseExpr ('(':rest :: String
rest) = ([[Expr]] -> Expr) -> ([[Expr]], String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (CommaSeparated [Expr] -> Expr
Parens (CommaSeparated [Expr] -> Expr)
-> ([[Expr]] -> CommaSeparated [Expr]) -> [[Expr]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> CommaSeparated [Expr]
forall a. [a] -> CommaSeparated a
CommaSeparated) (([[Expr]], String) -> (Expr, String))
-> ([[Expr]], String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ Char -> String -> ([[Expr]], String)
parseCSep ')' String
rest
parseExpr ('[':rest :: String
rest) = ([[Expr]] -> Expr) -> ([[Expr]], String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (CommaSeparated [Expr] -> Expr
Brackets (CommaSeparated [Expr] -> Expr)
-> ([[Expr]] -> CommaSeparated [Expr]) -> [[Expr]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> CommaSeparated [Expr]
forall a. [a] -> CommaSeparated a
CommaSeparated) (([[Expr]], String) -> (Expr, String))
-> ([[Expr]], String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ Char -> String -> ([[Expr]], String)
parseCSep ']' String
rest
parseExpr ('{':rest :: String
rest) = ([[Expr]] -> Expr) -> ([[Expr]], String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (CommaSeparated [Expr] -> Expr
Braces (CommaSeparated [Expr] -> Expr)
-> ([[Expr]] -> CommaSeparated [Expr]) -> [[Expr]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> CommaSeparated [Expr]
forall a. [a] -> CommaSeparated a
CommaSeparated) (([[Expr]], String) -> (Expr, String))
-> ([[Expr]], String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ Char -> String -> ([[Expr]], String)
parseCSep '}' String
rest
parseExpr ('"':rest :: String
rest) = (String -> Expr) -> (String, String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Expr
StringLit ((String, String) -> (Expr, String))
-> (String, String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
parseStringLit String
rest
parseExpr ('\'':rest :: String
rest) = (String -> Expr) -> (String, String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Expr
CharLit ((String, String) -> (Expr, String))
-> (String, String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
parseCharLit String
rest
parseExpr (c :: Char
c:rest :: String
rest) | Char -> Bool
isDigit Char
c = (String -> Expr) -> (String, String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Expr
NumberLit ((String, String) -> (Expr, String))
-> (String, String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ Char -> String -> (String, String)
parseNumberLit Char
c String
rest
parseExpr other :: String
other = (String -> Expr) -> (String, String) -> (Expr, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Expr
Other ((String, String) -> (Expr, String))
-> (String, String) -> (Expr, String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
parseOther String
other
parseExprs :: String -> ([Expr], String)
parseExprs :: String -> ([Expr], String)
parseExprs [] = ([], "")
parseExprs s :: String
s@(c :: Char
c:_)
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (")]}," :: String) = ([], String
s)
| Bool
otherwise = let (parsed :: Expr
parsed, rest' :: String
rest') = String -> (Expr, String)
parseExpr String
s
(toParse :: [Expr]
toParse, rest :: String
rest) = String -> ([Expr], String)
parseExprs String
rest'
in (Expr
parsed Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
toParse, String
rest)
parseCSep :: Char -> String -> ([[Expr]], String)
parseCSep :: Char -> String -> ([[Expr]], String)
parseCSep _ [] = ([], "")
parseCSep end :: Char
end s :: String
s@(c :: Char
c:cs :: String
cs)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end = ([], String
cs)
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (")]}" :: String) = ([], String
s)
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' = Char -> String -> ([[Expr]], String)
parseCSep Char
end String
cs
| Bool
otherwise = let (parsed :: [Expr]
parsed, rest' :: String
rest') = String -> ([Expr], String)
parseExprs String
s
(toParse :: [[Expr]]
toParse, rest :: String
rest) = Char -> String -> ([[Expr]], String)
parseCSep Char
end String
rest'
in ([Expr]
parsed [Expr] -> [[Expr]] -> [[Expr]]
forall a. a -> [a] -> [a]
: [[Expr]]
toParse, String
rest)
parseStringLit :: String -> (String, String)
parseStringLit :: String -> (String, String)
parseStringLit [] = ("", "")
parseStringLit ('"':rest :: String
rest) = ("", String
rest)
parseStringLit ('\\':c :: Char
c:cs :: String
cs) = ('\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs', String
rest)
where (cs' :: String
cs', rest :: String
rest) = String -> (String, String)
parseStringLit String
cs
parseStringLit (c :: Char
c:cs :: String
cs) = (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs', String
rest)
where (cs' :: String
cs', rest :: String
rest) = String -> (String, String)
parseStringLit String
cs
parseCharLit :: String -> (String, String)
parseCharLit :: String -> (String, String)
parseCharLit [] = ("", "")
parseCharLit ('\'':rest :: String
rest) = ("", String
rest)
parseCharLit ('\\':c :: Char
c:cs :: String
cs) = ('\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs', String
rest)
where (cs' :: String
cs', rest :: String
rest) = String -> (String, String)
parseCharLit String
cs
parseCharLit (c :: Char
c:cs :: String
cs) = (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs', String
rest)
where (cs' :: String
cs', rest :: String
rest) = String -> (String, String)
parseCharLit String
cs
parseNumberLit :: Char -> String -> (String, String)
parseNumberLit :: Char -> String -> (String, String)
parseNumberLit firstDigit :: Char
firstDigit rest1 :: String
rest1 =
case String
rest2 of
[] -> (Char
firstDigitChar -> String -> String
forall a. a -> [a] -> [a]
:String
remainingDigits, "")
'.':rest3 :: String
rest3 ->
let (digitsAfterDot :: String
digitsAfterDot, rest4 :: String
rest4) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest3
in ((Char
firstDigit Char -> String -> String
forall a. a -> [a] -> [a]
: String
remainingDigits) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ('.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
digitsAfterDot), String
rest4)
_ -> (Char
firstDigitChar -> String -> String
forall a. a -> [a] -> [a]
:String
remainingDigits, String
rest2)
where
remainingDigits :: String
rest2 :: String
(remainingDigits :: String
remainingDigits, rest2 :: String
rest2) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
rest1
parseOther :: String -> (String, String)
parseOther :: String -> (String, String)
parseOther = Bool -> String -> (String, String)
go Bool
False
where
go
:: Bool
-> String
-> (String, String)
go :: Bool -> String -> (String, String)
go _ [] = ("", "")
go insideIdent :: Bool
insideIdent cs :: String
cs@(c :: Char
c:cs' :: String
cs')
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("{[()]}\"'," :: String) = ("", String
cs)
| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
insideIdent = ("", String
cs)
| Bool
insideIdent = (String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (Bool -> String -> (String, String)
go (Char -> Bool
isIdentRest Char
c) String
cs')
| Bool
otherwise = (String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
:) (Bool -> String -> (String, String)
go (Char -> Bool
isIdentBegin Char
c) String
cs')
isIdentBegin :: Char -> Bool
isIdentBegin :: Char -> Bool
isIdentBegin '_' = Bool
True
isIdentBegin c :: Char
c = Char -> Bool
isAlpha Char
c
isIdentRest :: Char -> Bool
isIdentRest :: Char -> Bool
isIdentRest '_' = Bool
True
isIdentRest '\'' = Bool
True
isIdentRest c :: Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c