{-# LANGUAGE ViewPatterns #-}
module Language.Egison.Pretty.Pattern.External
( name
, varName
, valueExpr
)
where
import Data.Text ( Text
, unpack
)
import Language.Egison.Pretty.Pattern.Prim
( Doc
, text
, parens
)
import Language.Egison.Pretty.Pattern.Print
( Print
, askMode
)
import Language.Egison.Pretty.Pattern.PrintMode
( PrintMode(..) )
surroundedBy :: (Char, Char) -> String -> Bool
surroundedBy :: (Char, Char) -> String -> Bool
surroundedBy (Char
begin, Char
end) (Char
h : (String -> String
forall a. [a] -> [a]
reverse -> (Char
l : String
body)))
| Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
begin Bool -> Bool -> Bool
&& Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end = (Char -> Int -> Int) -> Int -> String -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> Int -> Int
go Int
0 String
body Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
where
go :: Char -> Int -> Int
go :: Char -> Int -> Int
go Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
begin = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
end = (-) Int
1
| Bool
otherwise = Int -> Int
forall a. a -> a
id
surroundedBy (Char, Char)
_ String
_ = Bool
False
lexicalChunk :: Text -> Doc
lexicalChunk :: Text -> Doc
lexicalChunk Text
txt
| String -> Bool
forall (t :: * -> *). Foldable t => t Char -> Bool
containsDelimiter String
str Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
checkSurrounding String
str) = Doc -> Doc
forall ann. Doc ann -> Doc ann
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
txt
| Bool
otherwise = Text -> Doc
text Text
txt
where
containsDelimiter :: t Char -> Bool
containsDelimiter t Char
x = Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
' ' t Char
x Bool -> Bool -> Bool
|| Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
',' t Char
x Bool -> Bool -> Bool
|| Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
')' t Char
x Bool -> Bool -> Bool
|| Char -> t Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
']' t Char
x
checkSurrounding :: String -> Bool
checkSurrounding String
x = (Char, Char) -> String -> Bool
surroundedBy (Char
'(', Char
')') String
x Bool -> Bool -> Bool
|| (Char, Char) -> String -> Bool
surroundedBy (Char
'[', Char
']') String
x
str :: String
str = Text -> String
unpack Text
txt
varName :: v -> Print n v e Doc
varName :: v -> Print n v e Doc
varName v
v = do
PrintMode { ExtPrinter v
$sel:varNamePrinter:PrintMode :: forall n v e. PrintMode n v e -> ExtPrinter v
varNamePrinter :: ExtPrinter v
varNamePrinter } <- Print n v e (PrintMode n v e)
forall n v e. Print n v e (PrintMode n v e)
askMode
Doc -> Print n v e Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Print n v e Doc)
-> (Text -> Doc) -> Text -> Print n v e Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
lexicalChunk (Text -> Print n v e Doc) -> Text -> Print n v e Doc
forall a b. (a -> b) -> a -> b
$ ExtPrinter v
varNamePrinter v
v
name :: n -> Print n v e Doc
name :: n -> Print n v e Doc
name n
n = do
PrintMode { ExtPrinter n
$sel:namePrinter:PrintMode :: forall n v e. PrintMode n v e -> ExtPrinter n
namePrinter :: ExtPrinter n
namePrinter } <- Print n v e (PrintMode n v e)
forall n v e. Print n v e (PrintMode n v e)
askMode
Doc -> Print n v e Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Print n v e Doc)
-> (Text -> Doc) -> Text -> Print n v e Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
lexicalChunk (Text -> Print n v e Doc) -> Text -> Print n v e Doc
forall a b. (a -> b) -> a -> b
$ ExtPrinter n
namePrinter n
n
valueExpr :: e -> Print n v e Doc
valueExpr :: e -> Print n v e Doc
valueExpr e
e = do
PrintMode { ExtPrinter e
$sel:valueExprPrinter:PrintMode :: forall n v e. PrintMode n v e -> ExtPrinter e
valueExprPrinter :: ExtPrinter e
valueExprPrinter } <- Print n v e (PrintMode n v e)
forall n v e. Print n v e (PrintMode n v e)
askMode
Doc -> Print n v e Doc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Print n v e Doc)
-> (Text -> Doc) -> Text -> Print n v e Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
lexicalChunk (Text -> Print n v e Doc) -> Text -> Print n v e Doc
forall a b. (a -> b) -> a -> b
$ ExtPrinter e
valueExprPrinter e
e