-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0
-- | Tests on the interpolator in overall.
module Test.Interpolator where
import Control.Monad.Reader (ask, runReader)
import Data.Functor.Identity (Identity (..))
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import Fmt (Buildable (..), Builder)
import Test.HUnit ((@?=))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Text.Interpolation.Nyan.RModes.Buildable
import Text.Interpolation.Nyan.RModes.CommonExtra
import Test.Util
import Text.Interpolation.Nyan.Core
newtype PrintedValue = PrintedValue Int
deriving stock (Show)
instance Buildable PrintedValue where
build (PrintedValue a) = "v = " <> build a
-- | Verifies that two types are equal without trying to make types
-- more concrete. I.e. some polymorphic type won't be equal to a concrete type.
class TypeEq a b where
cast :: a -> b
instance TypeEq a a where
cast = id
rmode'mega :: RMode Builder
rmode'mega = RMode \t -> "mega " <> t
test_DefaultInterpolator :: TestTree
test_DefaultInterpolator = testGroup "Default interpolator"
[ testCase "Empty text" do
[int|t||]
@?= ""
, testCase "Simple text" do
[int|t|Abc def|]
@?= "Abc def"
, testGroup "Interpolation"
[ testCase "Simple case" do
let a = "X" :: Text
[int|t|Value: #{a}|]
@?= "Value: X"
, testCase "Several interpolators" do
let a = "X" :: Text
let b = "Y" :: Text
let c = "Z" :: Text
[int|t|Values: {#{a}, #{b}} and #{c}|]
@?= "Values: {X, Y} and Z"
, testCase "Rendering modes" do
let a = PrintedValue 1
let n = 5
let s = "string"
[int|t|#{a}, #s{a}, #d{n}, #l{s}|]
@?= "v = 1, PrintedValue 1, 5, string"
, testCase "Locally defined rendering mode" do
let s = "nyan"
[int|t|#mega{s}|]
@?= "mega nyan"
, testCase "Spaces in {}" do
let a = 5
let s = "string"
[int|t|#d{ a }, #l{ s }|]
@?= "5, string"
]
, testGroup "Escaping"
[ testCase "Newline" do
[int|t|
x = 1, \
y = 2
|] @?= "x = 1, y = 2\n"
, testCase "Space" do
let n = 5
[int|t|Value: #d{n}|]
@?= "Value: 5"
, testCase "Slash" do
[int|t|a \\ b|]
@?= "a \\ b"
, testCase "Hash" do
[int|t|a \#{ .. }|]
@?= "a #{ .. }"
]
-------------------------------------------------------------------
, testGroup "Switches behaviour"
----------------------------------
[ testGroup "Spaces trimming"
[ testCase "Simple test" do
[int|ts| abc |]
@?= "abc"
, testCase "Multiline text" do
[int|ts|
abc
sdf
|]
@?= "abc\n\nsdf"
, testCase "Interpolator" do
let n = 5
[int|ts| #d{n} |]
@?= "5"
]
, ----------------------------------
testGroup "Indentation stripping"
[ testCase "Basic case" do
[int|t|
abc
kek
def
|] @?= "abc\n kek\ndef\n"
, testCase "The first line does not break IS" do
[int|t|abc
kek
def
|] @?= "abc\n kek\ndef\n"
, testCase "Putting quoter end eariler does not affect IS" do
[int|t|
abc
kek
def
|] @?= "abc\n kek\ndef\n"
, testCase "Putting quoter end later does not affect IS" do
[int|t|
abc
kek
def
|] @?= "abc\n kek\ndef\n"
, testCase "Indentation stripping disabling works" do
[int|tD|
abc
kek
def
|]
@?= " abc\n kek\n def\n"
]
----------------------------------
, testGroup "Leading newline stripping"
[ testCase "Simple multiline text" do
[int|tA|
Abc
def
|]
@?= "\nAbc\ndef\n"
, testCase "The first non-empty line affects indentation of other text" do
[int|tA|
Abc
def
|]
@?= "\nAbc\n def\n"
]
----------------------------------
, testGroup "Trailing spaces stripping"
[ testCase "Simple multiline text" do
[int|tZ|
Abc
|]
@?= "Abc\n"
, testCase "Extra spaces at end" do
[int|tZ|
Abc
|]
@?= "Abc\n "
, testCase "Affects indentation of other text" do
[int|tZ|
Abc
|]
@?= " Abc\n"
]
----------------------------------
, testGroup "Newlines reduction"
[ testCase "Basic case" do
let theVeryLongVariableNoOneKnowsWhyButWhyNot = "a"
let anotherVeryLongVariableIsThereAReasonToGoLikeThisMmm = "b"
[int|tn|
X=#l{theVeryLongVariableNoOneKnowsWhyButWhyNot},
x=#l{anotherVeryLongVariableIsThereAReasonToGoLikeThisMmm}
Yyy
Zzzz
|] @?= "X=a, x=b\nYyy\n\n\nZzzz"
, testCase "Multiline code" do
let aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa = "a"
[int|tn|
X = #l{
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
}
yep.
|] @?= "X = a yep.\n"
, testCase "No surrounding newlines" do
[int|tn|Abc
def|] @?= "Abc\ndef"
]
----------------------------------
, testGroup "Monadic"
[ testCase "Arrow monad" do
[int|tm|(#d{fst}, #d{snd})|] (1, 2)
@?= "(1, 2)"
, testCase "Reader monad" do
[int|tm|Env: #d{ask}|] `runReader` 1
@?= "Env: 1"
, testCase "No interpolated values" do
[int|tm|Abc|]
@?= Identity "Abc"
]
----------------------------------
, testGroup "Return type"
[ testCase "Polymorphic" do
[int||Abc|]
@?= ("Abc" :: Text)
, testCase "Text" do
cast [int|t|Abc|]
@?= ("Abc" :: Text)
, testCase "Lazy text" do
cast [int|T|Abc|]
@?= ("Abc" :: LT.Text)
, testCase "Text" do
cast [int|b|Abc|]
@?= ("Abc" :: Builder)
, testCase "String (via polymorphic)" do
[int||Abc|]
@?= ("Abc" :: String)
]
]
]
-- test_ManagingDefaultSwitches :: TestTree
-- test_ManagingDefaultSwitches = testGroup "Managing default switches"
-- [ testCase "Spacing enabled by default" do
-- let dsopts = defaultInterpolatorOptions
-- { defaultSwitchesOptions = basicDefaultSwitchesOptions
-- { defSpacesTrimming = Just True
-- }
-- }
-- let intc = mkInt dsOpts
-- [intc|ts| abc |] @?= "abc"
-- ]
test_HaskellEnvironment :: TestTree
test_HaskellEnvironment = testGroup "Haskell environment"
[ testGroup "Overloaded labels"
[ -- TODO
]
]