-----------------------------------------------------------------------------
--
-- Module      :  StringInfix

-- infix operations with <X> to insert X in between - unconditional
-- even if the two strings are empty
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_GHC -w #-}

module Uniform.Strings.Infix  where

import           GHC.Exts                 (IsString (..))
import Uniform.Strings.Conversion ( Text )
import Uniform.Strings.Utilities ( CharChains(append) )


(<:>) :: Text -> Text -> Text
-- ^ append text with colon in between
Text
a <:> :: Text -> Text -> Text
<:> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

--(<+>) :: (IsString s, CharChains s) => s -> s -> s
(<+>) :: Text -> Text -> Text
-- append text with plus in between
Text
a <+> :: Text -> Text -> Text
<+> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

--(<->) :: (IsString s, CharChains s) => s -> s -> s
(<->) :: Text -> Text -> Text
-- ^ append text with dash in between
Text
a <-> :: Text -> Text -> Text
<-> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

--(</>) :: (IsString s, CharChains s) => s -> s -> s
(</>) :: Text -> Text -> Text
-- ^ append text with slash in between
Text
a </> :: Text -> Text -> Text
</> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

(<.>) :: Text -> Text -> Text
Text
a <.> :: Text -> Text -> Text
<.> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b
-- ^ append text with dot in between

(<#>) :: Text -> Text -> Text
-- append text with hash in between
Text
a <#> :: Text -> Text -> Text
<#> Text
b = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b

(<|>) :: Text -> Text -> Text
-- ^ append text with blank in between, (a character does not work as name)
-- possible conflict with parsec
Text
a <|> :: Text -> Text -> Text
<|> Text
x = Text
a  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

wrapInSpitz :: Text -> Text
-- ^ insert text in <..>
wrapInSpitz :: Text -> Text
wrapInSpitz Text
a = Text
"<"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
">"

wrapInDoubleQuotes :: Text -> Text
-- ^ insert text in <..>
wrapInDoubleQuotes :: Text -> Text
wrapInDoubleQuotes Text
a = Text
"\""  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
"\""

wrapInBraces :: Text -> Text
-- ^ insert text in <..>
wrapInBraces :: Text -> Text
wrapInBraces Text
a = Text
"{"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
"}"

addXatEnd :: (IsString s, CharChains s) => s -> s -> s
addXatEnd :: s -> s -> s
addXatEnd = (s -> s -> s) -> s -> s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> s -> s
forall a. CharChains a => a -> a -> a
append