module Text.StringTemplate.Classes
(SElem(..), StringTemplateShows(..), ToSElem(..), SMap, STShow(..),
StFirst(..), Stringable(..), stShowsToSE
) where
import qualified Data.Map as M
import Data.List
import Data.Monoid
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
import qualified Text.PrettyPrint.HughesPJ as PP
newtype StFirst a = StFirst { stGetFirst :: Maybe a }
deriving (Eq, Ord, Read, Show)
instance Monoid (StFirst a) where
mempty = StFirst Nothing
r@(StFirst (Just _)) `mappend` _ = r
StFirst Nothing `mappend` r = r
instance Functor StFirst where
fmap f = StFirst . fmap f . stGetFirst
type SMap a = M.Map String (SElem a)
data SElem a = STR String
| BS LB.ByteString
| STSH STShow
| SM (SMap a)
| LI [SElem a]
| SBLE a
| SNAT a
| SNull
class ToSElem a where
toSElem :: Stringable b => a -> SElem b
toSElemList :: Stringable b => [a] -> SElem b
toSElemList = LI . map toSElem
class (Show a) => StringTemplateShows a where
stringTemplateShow :: a -> String
stringTemplateShow = show
stringTemplateFormattedShow :: String -> a -> String
stringTemplateFormattedShow = flip $ const . stringTemplateShow
stShowsToSE :: (StringTemplateShows a, Stringable b) => a -> SElem b
stShowsToSE = STSH . STShow
data STShow = forall a.(StringTemplateShows a) => STShow a
class Stringable a where
stFromString :: String -> a
stFromByteString :: LB.ByteString -> a
stFromByteString = stFromString . LB.unpack
stToString :: a -> String
mconcatMap :: [b] -> (b -> a) -> a
mconcatMap m k = foldr (smappend . k) smempty m
mintercalate :: a -> [a] -> a
mintercalate = (smconcat .) . intersperse
mlabel :: a -> a -> a
mlabel x y = smconcat [x, stFromString "[", y, stFromString "]"]
smempty :: a
smappend :: a -> a -> a
smconcat :: [a] -> a
smconcat xs = foldr (smappend . id) smempty xs
instance Stringable String where
stFromString = id
stToString = id
smempty = ""
smappend = (++)
instance Stringable PP.Doc where
stFromString = PP.text
stToString = PP.render
mconcatMap m k = PP.fcat . map k $ m
mintercalate = (PP.fcat .) . PP.punctuate
mlabel x y = x PP.$$ PP.nest 1 y
smempty = PP.empty
smappend = (PP.<>)
instance Stringable B.ByteString where
stFromString = B.pack
stFromByteString = B.concat . LB.toChunks
stToString = B.unpack
smempty = B.empty
smappend = B.append
instance Stringable LB.ByteString where
stFromString = LB.pack
stFromByteString = id
stToString = LB.unpack
smempty = LB.empty
smappend = LB.append
instance Stringable T.Text where
stFromString = T.pack
stFromByteString = T.decodeUtf8 . B.concat . LB.toChunks
stToString = T.unpack
smempty = T.empty
smappend = T.append
instance Stringable LT.Text where
stFromString = LT.pack
stFromByteString = LT.decodeUtf8
stToString = LT.unpack
smempty = LT.empty
smappend = LT.append
instance Stringable (Endo String) where
stFromString = Endo . (++)
stToString = ($ []) . appEndo
smempty = mempty
smappend = mappend