about summary refs log tree commit diff
path: root/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs')
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs80
1 files changed, 0 insertions, 80 deletions
diff --git a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs b/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
deleted file mode 100644
index 2a3873c3b016..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
+++ /dev/null
@@ -1,80 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Messages.TemplateSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
-import Test.QuickCheck.Instances.Text ()
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Function (fix)
---------------------------------------------------------------------------------
-import Xanthous.Messages.Template
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Messages.Template"
-  [ testGroup "parsing"
-    [ testProperty "literals" $ forAll genLiteral $ \s ->
-        testParse template s === Right (Literal s)
-    , parseCase "escaped curlies"
-      "foo\\{"
-      $ Literal "foo{"
-    , parseCase "simple substitution"
-      "foo {{bar}}"
-      $ Literal "foo " `Concat` Subst (SubstPath $ "bar" :| [])
-    , parseCase "substitution with filters"
-      "foo {{bar | baz}}"
-      $ Literal "foo "
-      `Concat` Subst (SubstFilter (SubstPath $ "bar" :| [])
-                                  (FilterName "baz"))
-    , parseCase "substitution with multiple filters"
-      "foo {{bar | baz | qux}}"
-      $ Literal "foo "
-      `Concat` Subst (SubstFilter (SubstFilter (SubstPath $ "bar" :| [])
-                                                (FilterName "baz"))
-                                  (FilterName "qux"))
-    , parseCase "two substitutions and a literal"
-      "{{a}}{{b}}c"
-      $ Subst (SubstPath $ "a" :| [])
-      `Concat` Subst (SubstPath $ "b" :| [])
-      `Concat` Literal "c"
-    , localOption (QuickCheckTests 10)
-    $ testProperty "round-trips with ppTemplate" $ \tpl ->
-        testParse template (ppTemplate tpl) === Right tpl
-    ]
-  , testBatch $ monoid @Template mempty
-  , testGroup "rendering"
-    [ testProperty "rendering literals renders literally"
-      $ forAll genLiteral $ \s fs vs ->
-        render fs vs (Literal s) === Right s
-    , testProperty "rendering substitutions renders substitutions"
-      $ forAll genPath $ \ident val fs ->
-        let tpl = Subst (SubstPath ident)
-            tvs = varsWith ident val
-        in render fs tvs tpl === Right val
-    , testProperty "filters filter" $ forAll genPath
-      $ \ident filterName filterFn val ->
-        let tpl = Subst (SubstFilter (SubstPath ident) filterName)
-            fs = mapFromList [(filterName, filterFn)]
-            vs = varsWith ident val
-        in render fs vs tpl === Right (filterFn val)
-    ]
-  ]
-  where
-    genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary
-    parseCase name input expected =
-      testCase name $ testParse template input @?= Right expected
-    testParse p = over _Left errorBundlePretty . runParser p "<test>"
-    genIdentifier = pack @Text <$> listOf1 (elements identifierChars)
-    identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_']
-
-    varsWith (p :| []) val = vars [(p, Val val)]
-    varsWith (phead :| ps) val = vars . pure . (phead ,) . flip fix ps $
-      \next pth -> case pth of
-          [] -> Val val
-          p : ps' -> nested [(p, next ps')]
-
-    genPath = (:|) <$> genIdentifier <*> listOf genIdentifier
-
---