1 files changed, 0 insertions, 275 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Messages/Template.hs b/users/grfn/xanthous/src/Xanthous/Messages/Template.hs
deleted file mode 100644
index 5176880355f4..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Messages/Template.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------------------
-module Xanthous.Messages.Template
-  ( -- * Template AST
-    Template(..)
-  , Substitution(..)
-  , Filter(..)
-
-    -- ** Template AST transformations
-  , reduceTemplate
-
-    -- * Template parser
-  , template
-  , runParser
-  , errorBundlePretty
-
-    -- * Template pretty-printer
-  , ppTemplate
-
-    -- * Rendering templates
-  , TemplateVar(..)
-  , nested
-  , TemplateVars(..)
-  , vars
-  , RenderError
-  , render
-  )
-where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding
-                 (many, concat, try, elements, some, parts)
---------------------------------------------------------------------------------
-import           Test.QuickCheck hiding (label)
-import           Test.QuickCheck.Instances.Text ()
-import           Test.QuickCheck.Instances.Semigroup ()
-import           Test.QuickCheck.Checkers (EqProp)
-import           Control.Monad.Combinators.NonEmpty
-import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Data
-import           Text.Megaparsec hiding (sepBy1, some)
-import           Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import           Data.Function (fix)
---------------------------------------------------------------------------------
-import Xanthous.Util (EqEqProp(..))
---------------------------------------------------------------------------------
-
-genIdentifier :: Gen Text
-genIdentifier = pack <$> listOf1 (elements identifierChars)
-
-identifierChars :: String
-identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_']
-
-newtype Filter = FilterName Text
-  deriving stock (Show, Eq, Ord, Generic, Data)
-  deriving anyclass (NFData)
-  deriving (IsString) via Text
-
-instance Arbitrary Filter where
-  arbitrary = FilterName <$> genIdentifier
-  shrink (FilterName fn) = fmap FilterName . filter (not . null) $ shrink fn
-
-data Substitution
-  = SubstPath (NonEmpty Text)
-  | SubstFilter Substitution Filter
-  deriving stock (Show, Eq, Ord, Generic, Data)
-  deriving anyclass (NFData)
-
-instance Arbitrary Substitution where
-  arbitrary = sized . fix $ \gen n ->
-    let leaves =
-          [ SubstPath <$> ((:|) <$> genIdentifier <*> listOf genIdentifier)]
-        subtree = gen $ n `div` 2
-    in if n == 0
-       then oneof leaves
-       else oneof $ leaves <> [ SubstFilter <$> subtree <*> arbitrary ]
-  shrink (SubstPath pth) =
-    fmap SubstPath
-    . filter (not . any ((||) <$> null <*> any (`notElem` identifierChars)))
-    $ shrink pth
-  shrink (SubstFilter s f)
-    = shrink s
-    <> (uncurry SubstFilter <$> shrink (s, f))
-
-data Template
-  = Literal Text
-  | Subst Substitution
-  | Concat Template Template
-  deriving stock (Show, Generic, Data)
-  deriving anyclass (NFData)
-  deriving EqProp via EqEqProp Template
-
-instance Plated Template where
-  plate _ tpl@(Literal _) = pure tpl
-  plate _ tpl@(Subst _) = pure tpl
-  plate f (Concat tpl₁ tpl₂) = Concat <$> f tpl₁ <*> f tpl₂
-
-reduceTemplate :: Template -> Template
-reduceTemplate = transform $ \case
-  (Concat (Literal t₁) (Literal t₂)) -> Literal (t₁ <> t₂)
-  (Concat (Literal "") t) -> t
-  (Concat t (Literal "")) -> t
-  (Concat t₁ (Concat t₂ t₃)) -> Concat (Concat t₁ t₂) t₃
-  (Concat (Concat t₁ (Literal t₂)) (Literal t₃)) -> (Concat t₁ (Literal $ t₂ <> t₃))
-  t -> t
-
-instance Eq Template where
-  tpl₁ == tpl₂ = case (reduceTemplate tpl₁, reduceTemplate tpl₂) of
-    (Literal t₁, Literal t₂) -> t₁ == t₂
-    (Subst s₁, Subst s₂) -> s₁ == s₂
-    (Concat ta₁ ta₂, Concat tb₁ tb₂) -> ta₁ == tb₁ && ta₂ == tb₂
-    _ -> False
-
-instance Arbitrary Template where
-  arbitrary = sized . fix $ \gen n ->
-    let leaves = [ Literal . pack . filter (`notElem` ['\\', '{']) <$> arbitrary
-                 , Subst <$> arbitrary
-                 ]
-        subtree = gen $ n `div` 2
-        genConcat = Concat <$> subtree <*> subtree
-    in if n == 0
-       then oneof leaves
-       else oneof $ genConcat : leaves
-  shrink (Literal t) = Literal <$> shrink t
-  shrink (Subst s) = Subst <$> shrink s
-  shrink (Concat t₁ t₂)
-    = shrink t₁
-    <> shrink t₂
-    <> (Concat <$> shrink t₁ <*> shrink t₂)
-
-instance Semigroup Template where
-  (<>) = Concat
-
-instance Monoid Template where
-  mempty = Literal ""
-
---------------------------------------------------------------------------------
-
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space space1 empty empty
-
-lexeme :: Parser a -> Parser a
-lexeme = L.lexeme sc
-
-symbol :: Text -> Parser Text
-symbol = L.symbol sc
-
-identifier :: Parser Text
-identifier = lexeme . label "identifier" $ do
-  firstChar <- letterChar <|> oneOf ['-', '_']
-  restChars <- many $ alphaNumChar <|> oneOf ['-', '_']
-  pure $ firstChar <| pack restChars
-
-filterName :: Parser Filter
-filterName = FilterName <$> identifier
-
-substitutionPath :: Parser Substitution
-substitutionPath = SubstPath <$> sepBy1 identifier (char '.')
-
-substitutionFilter :: Parser Substitution
-substitutionFilter = do
-  path <- substitutionPath
-  fs <- some $ symbol "|" *> filterName
-  pure $ foldl' SubstFilter path fs
-  -- pure $ SubstFilter path f
-
-substitutionContents :: Parser Substitution
-substitutionContents
-  =   try substitutionFilter
-  <|> substitutionPath
-
-substitution :: Parser Substitution
-substitution = between (string "{{") (string "}}") substitutionContents
-
-literal :: Parser Template
-literal = Literal <$>
-  (   (string "\\{" $> "{")
-  <|> takeWhile1P Nothing (`notElem` ['\\', '{'])
-  )
-
-subst :: Parser Template
-subst = Subst <$> substitution
-
-template' :: Parser Template
-template' = do
-  parts <- many $ literal <|> subst
-  pure $ foldr Concat (Literal "") parts
-
-
-template :: Parser Template
-template = reduceTemplate <$> template' <* eof
-
---------------------------------------------------------------------------------
-
-ppSubstitution :: Substitution -> Text
-ppSubstitution (SubstPath substParts) = intercalate "." substParts
-ppSubstitution (SubstFilter s (FilterName f)) = ppSubstitution s <> " | " <> f
-
-ppTemplate :: Template -> Text
-ppTemplate (Literal txt) = txt
-ppTemplate (Subst s) = "{{" <> ppSubstitution s <> "}}"
-ppTemplate (Concat tpl₁ tpl₂) = ppTemplate tpl₁ <> ppTemplate tpl₂
-
---------------------------------------------------------------------------------
-
-data TemplateVar
-  = Val Text
-  | Nested (Map Text TemplateVar)
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-nested :: [(Text, TemplateVar)] -> TemplateVar
-nested = Nested . mapFromList
-
-instance Arbitrary TemplateVar where
-  arbitrary = sized . fix $ \gen n ->
-    let nst = fmap mapFromList . listOf $ (,) <$> arbitrary <*> gen (n `div` 2)
-    in if n == 0
-       then Val <$> arbitrary
-       else oneof [ Val <$> arbitrary
-                  , Nested <$> nst]
-
-newtype TemplateVars = Vars { getTemplateVars :: Map Text TemplateVar }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-  deriving (Arbitrary) via (Map Text TemplateVar)
-
-type instance Index TemplateVars = Text
-type instance IxValue TemplateVars = TemplateVar
-instance Ixed TemplateVars where
-  ix k f (Vars vs) = Vars <$> ix k f vs
-instance At TemplateVars where
-  at k f (Vars vs) = Vars <$> at k f vs
-
-vars :: [(Text, TemplateVar)] -> TemplateVars
-vars = Vars . mapFromList
-
-lookupVar :: TemplateVars -> NonEmpty Text -> Maybe TemplateVar
-lookupVar vs (p :| []) = vs ^. at p
-lookupVar vs (p :| (p₁ : ps)) = vs ^. at p >>= \case
-  (Val _) -> Nothing
-  (Nested vs') -> lookupVar (Vars vs') $ p₁ :| ps
-
-data RenderError
-  = NoSuchVariable (NonEmpty Text)
-  | NestedFurther (NonEmpty Text)
-  | NoSuchFilter Filter
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-renderSubst
-  :: Map Filter (Text -> Text) -- ^ Filters
-  -> TemplateVars
-  -> Substitution
-  -> Either RenderError Text
-renderSubst _ vs (SubstPath pth) =
-  case lookupVar vs pth of
-    Just (Val v) -> Right v
-    Just (Nested _) -> Left $ NestedFurther pth
-    Nothing -> Left $ NoSuchVariable pth
-renderSubst fs vs (SubstFilter s fn) =
-  case fs ^. at fn of
-    Just filterFn -> filterFn <$> renderSubst fs vs s
-    Nothing -> Left $ NoSuchFilter fn
-
-render
-  :: Map Filter (Text -> Text) -- ^ Filters
-  -> TemplateVars             -- ^ Template variables
-  -> Template                 -- ^ Template
-  -> Either RenderError Text
-render _ _ (Literal s) = pure s
-render fs vs (Concat t₁ t₂) = (<>) <$> render fs vs t₁ <*> render fs vs t₂
-render fs vs (Subst s) = renderSubst fs vs s