{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
-- Bricks
import Bricks.Expression
import Bricks.Parsec
import Bricks.Rendering
-- Bricks internal
import Bricks.Internal.Prelude
import qualified Bricks.Internal.Seq as Seq
import Bricks.Internal.Text (Text)
import qualified Bricks.Internal.Text as Text
-- Bricks test
import Bricks.Test.Hedgehog
import Bricks.Test.QQ
-- Parsec
import qualified Text.Parsec as P
import Text.Parsec.Text (Parser)
-- Hedgehog
import Hedgehog (Property, property, withTests, (===))
import qualified Hedgehog
-- Base
import System.IO (IO)
import Text.Show (show)
main :: IO ()
main = runTests $$(Hedgehog.discover)
{- | We'll use the @parseTest@ function a lot to test parsers. It's a bit like
'P.parseTest' from the Parsec library, but it works on parsers of type 'Text'
rather than @'Show' a => a@. It also prints the unparsed input so we can verify
that our parser consumes the right amount of input, and it prints a message if
the parser fails and consumes input. -}
parseTest :: Parser Text -> Text -> Text
parseTest p input =
Text.intercalate "\n" $
catMaybes
[ Just $ case P.parse p "" input of
Left err ->
"Parse error at " <>
Text.replace "\n" "\n - " (Text.pack (show err))
Right x -> x
, let
p' = do
_ <- p
r <- P.many1 P.anyChar
pure $ "Remaining input: " <> Text.pack (show r)
in
case P.parse p' "" input of
Left _ -> Nothing
Right x -> Just x
, case P.parse (void p <|> pure ()) "" input of
Left _ -> Just "Parser failed and consumed input"
Right _ -> Nothing
]
prop_parse_str_unquoted :: Property
prop_parse_str_unquoted = withTests 1 $ property $ do
let test = parseTest $ fmap var'text $ parse'var
test "-ab_c" === [text|-ab_c|]
test "" === [text|┃Parse error at (line 1, column 1):
┃ - unexpected end of input|]
test "a\"b" === [text|┃a
┃Remaining input: "\"b"|]
test "a b" === [text|┃a
┃Remaining input: "b"|]
-- The unquoted string parser doesn't backtrack.
-- Note how in this example it fails and consumes input.
test "rec { }" === [text|┃Parse error at (line 1, column 4):
┃ - unexpected " "
┃Parser failed and consumed input|]
prop_parse_expression_dictKey :: Property
prop_parse_expression_dictKey = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'expression renderContext'default) $
parse'expression'dictKey
test "a" === [text|"a"|]
test "\"a\"" === [text|"a"|]
test "a b" === [text|┃"a"
┃Remaining input: "b"|]
test "${a.b}" === [text|a.b|]
prop_parse_strDynamic :: Property
prop_parse_strDynamic = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'strDynamic'quoted renderContext'default) $
parse'str'dynamic
test "\"a\"" === [text|"a"|]
test "\"a\" x" === [text|┃"a"
┃Remaining input: "x"|]
test "\"a ${b} c\"" === [text|"a ${b} c"|]
test "\"a${ b }c\"" === [text|"a${b}c"|]
test "\"$\"" === [text|"$"|]
test "\"a$\"" === [text|"a$"|]
test "\"\\${\"" === [text|"\${"|]
test "\"a\\${\"" === [text|"a\${"|]
prop_parse_strIndented :: Property
prop_parse_strIndented = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $ fmap render $
P.spaces *> parse'inStr
render :: InStr -> Text
render =
Text.intercalateMap "\n" render'1 . inStr'toSeq
render'1 :: InStr'1 -> Text
render'1 x =
Text.show (inStr'1'level x) <> " [" <>
Text.intercalateMap ", "
(\s ->
render'strDynamic'quoted renderContext'default $
Str'Dynamic (Seq.singleton s) Nothing
)
(inStr'1'str x) <>
"] " <> Text.show (isJust (inStr'1'lineBreak x))
test "''hello''x" === [text|┃0 ["hello"] False
┃Remaining input: "x"|]
test "''hello'' x" === [text|┃0 ["hello"] False
┃Remaining input: "x"|]
test [text|┃ ''
┃ one
┃ two
┃ ''x|] === [text|┃0 [] True
┃4 ["one"] True
┃4 ["two"] True
┃2 [] False
┃Remaining input: "x"|]
test [text|┃ ''
┃ one
┃
┃ two
┃ ''x|] === [text|┃0 [] True
┃4 ["one"] True
┃0 [] True
┃4 ["two"] True
┃2 [] False
┃Remaining input: "x"|]
test "'''' x" === [text|┃0 [] False
┃Remaining input: "x"|]
test "''abc''" === [text|0 ["abc"] False|]
test [text|┃''
┃''|]
=== [text|┃0 [] True
┃0 [] False|]
test [text|┃'' abc
┃def''|]
=== [text|┃3 ["abc"] True
┃0 ["def"] False|]
prop_parse_dict_pattern_start :: Property
prop_parse_dict_pattern_start = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
(P.try parse'dictPattern'start $> "yes") <|> pure "no"
test "{a, b}:" === [text|┃yes
┃Remaining input: " b}:"|]
test "{a ? 4, b}:" === [text|┃yes
┃Remaining input: " 4, b}:"|]
test "{ }: x" === [text|┃yes
┃Remaining input: " x"|]
-- { } is not enough to determine whether we're parsing a dict param, because
-- if it isn't followed by a colon, then it's actually an empty dict literal.
test "{ } x" === [text|┃no
┃Remaining input: "{ } x"|]
test "{ ... }:" === [text|┃yes
┃Remaining input: " }:"|]
prop_parse_dict_pattern :: Property
prop_parse_dict_pattern = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'dictPattern renderContext'default) $
parse'dictPattern
test "{}" === [text|{ }|]
test "{...}" === [text|{ ... }|]
test "{a}" === [text|{ a }|]
test "{a , b}" === [text|{ a, b }|]
test "{a , b ? c, ...}" === [text|{ a, b ? c, ... }|]
prop_parse_dot_rhs_chain :: Property
prop_parse_dot_rhs_chain = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (
Text.intercalate "\n" .
fmap (render'expression renderContext'default)
) $
parse'dot'rhs'chain
-- The dots parser /does/ match the empty string.
test "" === [text||]
-- The simplest nonempty dot list
test ".a" === [text|"a"|]
-- The dots parser consumes any trailing whitespace beyond the dot list.
test ".a " === [text|"a"|]
-- Dot attributes are usually unquoted strings, but they may also be quoted.
test ".\"a\"" === [text|"a"|]
test ". \"a\"" === [text|"a"|]
-- Here we throw some extra whitespace into the middle, which makes no
-- difference, and some extra stuff onto the end, which does not get consumed.
test ".a . b c" === [text|┃"a"
┃"b"
┃Remaining input: "c"|]
-- Another example of a quoted dot, this time following an unquoted dot
test ".a.\"b\"" === [text|┃"a"
┃"b"|]
-- If quotes or braces are involved, the stuff that follows a dot expression
-- can directly abut it with no whitespace in between.
test [text|.a."b"x|] === [text|┃"a"
┃"b"
┃Remaining input: "x"|]
test [text|.a.b"x"|] === [text|┃"a"
┃"b"
┃Remaining input: "\"x\""|]
test ".a.b(x)" === [text|┃"a"
┃"b"
┃Remaining input: "(x)"|]
test ". a . b" === [text|┃"a"
┃"b"|]
test ". \"a\".b" === [text|┃"a"
┃"b"|]
test ". \"a\".${b}" === [text|┃"a"
┃b|]
prop_parse_expression :: Property
prop_parse_expression = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'expression renderContext'default) $
parse'expression
-- The empty string is /not/ a valid expression.
test "" === [text|┃Parse error at (line 1, column 1):
┃ - unexpected end of input
┃ - expecting expression|]
-- A very simple expression: a one-letter variable
test "a" === [text|a|]
-- Parsing an expression consumes any subsequent whitespace.
test "a " === [text|a|]
-- When there are multiple expressions, that is parsed as a function call.
test "f x" === [text|f x|]
-- Expressions can directly abut each other, so it's important that the
-- expression parser is also able to read an expression even when another
-- expression directly follows it.
test "f[x y]" === [text|┃f [
┃ x
┃ y
┃]|]
-- A simple example of parsing a dot expression
test "a.b" === [text|a.b|]
-- Dot parsing also consumes trailing whitespace.
test "a.b " === [text|a.b|]
-- It looks odd when a subsequent expression appears after a dot expression
-- with no whitespace, but it is permitted.
test "a.b\"c\"" === [text|a.b "c"|]
-- A simple list example
test "[ a b ]" === [text|┃[
┃ a
┃ b
┃]|]
-- A list with trailing whitespace that get consumed
test "[ a b ] " === [text|┃[
┃ a
┃ b
┃]|]
-- A list that is in the left-hand side of a function call. This will fail at
-- runtime if the call is evaluated, because a list is not a function, but it
-- should /parse/ successfully.
test "[ a b ] x" === [text|┃[
┃ a
┃ b
┃] x|]
-- The same thing with other weird stuff on the left-hand side of a function
-- call.
test "{ a = b; } x" === [text|┃{
┃ a = b;
┃} x|]
test "{ } x" === [text|{ } x|]
-- Note that the case where an empty dict is on the left-hand side of a
-- function call looks very similar to the case where a function expression
-- using dict deconstruction with no bindings. The only difference is the
-- colon.
test "{ }: x" === [text|┃{ }:
┃x|]
-- A list with a function call inside
test "[ (f x) ]" === [text|┃[
┃ (f x)
┃]|]
test "[ a (f x) ]" === [text|┃[
┃ a
┃ (f x)
┃]|]
-- A minimal dict literal
test "{ x = y; }" === [text|┃{
┃ x = y;
┃}|]
-- The left-hand side of a dict binding is allowed to be any expression.
test "{ \"a b\" = y; }" === [text|┃{
┃ "a b" = y;
┃}|]
test "{ ${x} = y; }" === [text|┃{
┃ ${x} = y;
┃}|]
-- It may even be the empty string.
test "{ \"\" = y; }" === [text|┃{
┃ "" = y;
┃}|]
-- None of the conventional whitespace within a dict literal is mandatory.
test "{x=y;}" === [text|┃{
┃ x = y;
┃}|]
-- A simple dict literal with two bindings
test "{ x = y; a = b; }" === [text|┃{
┃ x = y;
┃ a = b;
┃}|]
-- The same thing without any whitespace
test "{x=y;a=b;}" === [text|┃{
┃ x = y;
┃ a = b;
┃}|]
-- Dicts with 'inherit' bindings
test "{ inherit a; }" === [text|┃{
┃ inherit a;
┃}|]
test "{ inherit a b; }" === [text|┃{
┃ inherit a b;
┃}|]
test "{ inherit (x) a b; }" === [text|┃{
┃ inherit (x) a b;
┃}|]
-- An inherit binding can be empty, although it is weird.
test "{ inherit; }" === [text|┃{
┃ inherit;
┃}|]
-- A simple function
test "x : y" === [text|┃x:
┃y|]
-- Whitespace before the colon is unconventional, but allowed.
test "x : y" === [text|┃x:
┃y|]
-- The space after the colon is not mandatory. (In Nix, this example would be
-- parsed as the string "x:y", but here we do not support URI literals.)
test "x:y" === [text|┃x:
┃y|]
-- A slightly bigger example where we're starting to nest more things
test "[ \"abc\" f { x = y; } ]"
=== [text|┃[
┃ "abc"
┃ f
┃ {
┃ x = y;
┃ }
┃]|]
test "[ \"abc\" (f { x = y; }) ]"
=== [text|┃[
┃ "abc"
┃ (f {
┃ x = y;
┃ })
┃]|]
-- This is not valid a expression (though the first bit of it is).
test "a b: c" === [text|┃a b
┃Remaining input: ": c"|]
-- This is not a valid expression.
test "(a b: c)" === [text|┃Parse error at (line 1, column 5):
┃ - unexpected ":"
┃ - expecting expression list item or ")"
┃Parser failed and consumed input|]
-- Some functions that use dict deconstruction
test "{ a, b, c ? x, ... }: g b (f a c)"
=== [text|┃{ a, b, c ? x, ... }:
┃g b (f a c)|]
test "{ x, ... }: f x" === [text|┃{ x, ... }:
┃f x|]
test "{ x?\"abc\" }: x" === [text|┃{ x ? "abc" }:
┃x|]
test "{ ... }: x" === [text|┃{ ... }:
┃x|]
test "a@{ x, ... }: f x" === [text|┃a@{ x, ... }:
┃f x|]
test "a@{ x?\"abc\" }: x" === [text|┃a@{ x ? "abc" }:
┃x|]
test "a@{ ... }: x" === [text|┃a@{ ... }:
┃x|]
-- A let expression
test "let f = x: plus one x; in f seven"
=== [text|┃let
┃ f = x:
┃ plus one x;
┃in
┃ f seven|]
-- A let binding list may be empty, although it is silly.
test "let in f x"
=== [text|┃let
┃in
┃ f x|]
-- Indented strings do not support any escape sequences.
test [text|┃''
┃ There \ is \n no \$ escape.
┃''|]
=== [text|┃''
┃ There \\ is \\n no \\$ escape.
┃''|]
-- Therefore if you want to include something like '' in an indented string,
-- you have to put it inside an antiquote.
test [text|┃''
┃ Isn't it
┃ ${"''"}interesting
┃''|]
=== [text|┃''
┃ Isn't it
┃ ${"''"}interesting
┃''|]
-- Comments
test [text|┃let -- hi
┃ x {- ! -} = "a"; -- yep
┃ in -- lol
┃ f x
┃|]
=== [text|┃let
┃ x = "a";
┃in
┃ f x|]
-- Nested block comments
test [text|┃f{- a
┃ -- b
┃ {- c {- d
┃ -}-} e
┃ -}x|]
=== "f x"
prop_parse_expression_list :: Property
prop_parse_expression_list = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (
Text.intercalate "\n" .
fmap (render'expression renderContext'default)
) $
parse'expressionList
test "" === [text||]
test "x y z" === [text|┃x
┃y
┃z|]
test "(a)b c(d)" === [text|┃a
┃b
┃c
┃d|]
test "a.\"b\"c" === [text|┃a.b
┃c|]
test "\"abc\" (f { x = y; })" === [text|┃"abc"
┃f {
┃ x = y;
┃}|]
-- Parsing lists of variables that are similar to keywords
test "r re reck" === [text|┃r
┃re
┃reck|]
test "r re rec { } reck" === [text|┃r
┃re
┃rec { }
┃reck|]
test "l le lets" === [text|┃l
┃le
┃lets|]
test "i ins" === [text|┃i
┃ins|]
test "inheri inherits" === [text|┃inheri
┃inherits|]
prop_parse_expression_list_item :: Property
prop_parse_expression_list_item = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'expression renderContext'default) $
parse'expressionList'1
test "abc def" === [text|┃abc
┃Remaining input: "def"|]
test "a.b c" === [text|┃a.b
┃Remaining input: "c"|]
test "a.\"b\"c" === [text|┃a.b
┃Remaining input: "c"|]
test "(a.b)c" === [text|┃a.b
┃Remaining input: "c"|]
test "a.b(c)" === [text|┃a.b
┃Remaining input: "(c)"|]
test "[ a b ]c" === [text|┃[
┃ a
┃ b
┃]
┃Remaining input: "c"|]
test "a[ b c ]" === [text|┃a
┃Remaining input: "[ b c ]"|]
test "\"a\"b" === [text|┃"a"
┃Remaining input: "b"|]
prop_parse_expression_list_item_no_dot :: Property
prop_parse_expression_list_item_no_dot = withTests 1 $ property $ do
let
test :: Text -> Text
test =
parseTest $
fmap (render'expression renderContext'default) $
parse'expressionList'1'noDot
test "a.b c" === [text|┃a
┃Remaining input: ".b c"|]