    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}

    {-|
    Module      : Text.Pretty.Simple.Internal.ExprParser
    Copyright   : (c) Dennis Gosnell, 2016
    License     : BSD-style (see LICENSE file)
    Maintainer  : cdep.illabout@gmail.com
    Stability   : experimental
    Portability : POSIX

    -}
    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' and 'testString2' are convenient to use in GHCi when playing
    -- around with how parsing works.
    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\"})}]"

    -- | See 'testString1'.
    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

    -- | Parse multiple expressions.
    --
    -- >>> parseExprs "Just 'a'"
    -- ([Other "Just ",CharLit "a"],"")
    --
    -- Handle escaped characters correctly
    --
    -- >>> parseExprs $ "Foo \"hello \\\"world!\""
    -- ([Other "Foo ",StringLit "hello \\\"world!"],"")
    -- >>> parseExprs $ "'\\''"
    -- ([CharLit "\\'"],"")
    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)
      -- Mismatch condition; if the end does not match, there is a mistake
      -- Perhaps there should be a Missing constructor for Expr
      | 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)

    -- | Parse string literals until a trailing double quote.
    --
    -- >>> parseStringLit "foobar\" baz"
    -- ("foobar"," baz")
    --
    -- Keep literal back slashes:
    --
    -- >>> parseStringLit "foobar\\\" baz\" after"
    -- ("foobar\\\" baz"," after")
    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

    -- | Parse character literals until a trailing single quote.
    --
    -- >>> parseCharLit "a' foobar"
    -- ("a"," foobar")
    --
    -- Keep literal back slashes:
    --
    -- >>> parseCharLit "\\'' hello"
    -- ("\\'"," hello")
    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

    -- | Parses integers and reals, like @123@ and @45.67@.
    --
    -- To be more precise, any numbers matching the regex @\\d+(\\.\\d+)?@ should
    -- get parsed by this function.
    --
    -- >>> parseNumberLit '3' "456hello world []"
    -- ("3456","hello world []")
    -- >>> parseNumberLit '0' ".12399880 foobar"
    -- ("0.12399880"," foobar")
    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

    -- | This function consumes input, stopping only when it hits a special
    -- character or a digit.  However, if the digit is in the middle of a
    -- Haskell-style identifier (e.g. @foo123@), then keep going
    -- anyway.
    --
    -- This is almost the same as the function
    --
    -- > parseOtherSimple = span $ \c ->
    -- >   notElem c ("{[()]}\"," :: String) && not (isDigit c) && (c /= '\'')
    --
    -- except 'parseOther' ignores digits and single quotes that appear in
    -- Haskell-like identifiers.
    --
    -- >>> parseOther "hello world []"
    -- ("hello world ","[]")
    -- >>> parseOther "hello234 world"
    -- ("hello234 world","")
    -- >>> parseOther "hello 234 world"
    -- ("hello ","234 world")
    -- >>> parseOther "hello{[ 234 world"
    -- ("hello","{[ 234 world")
    -- >>> parseOther "H3110 World"
    -- ("H3110 World","")
    -- >>> parseOther "Node' (Leaf' 1) (Leaf' 2)"
    -- ("Node' ","(Leaf' 1) (Leaf' 2)")
    -- >>> parseOther "I'm One"
    -- ("I'm One","")
    -- >>> parseOther "I'm 2"
    -- ("I'm ","2")
    parseOther :: String -> (String, String)
    parseOther :: String -> (String, String)
    parseOther = Bool -> String -> (String, String)
    go Bool
    False
      where
        go
          :: Bool
          -- ^ in an identifier?
          -> 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
    ignoreInIdent 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
    ignoreInIdent Char
    c

        ignoreInIdent :: Char -> Bool
        ignoreInIdent :: Char -> Bool
    ignoreInIdent x :: Char
    x = Char -> Bool
    isDigit Char
    x Bool -> Bool -> Bool
    || Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\''