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 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 x = StFirst . fmap f . stGetFirst $ x
type SMap a = M.Map String (SElem a)
data SElem a = STR String | STSH STShow | SM (SMap a) | LI [SElem a] | SBLE 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 Monoid a => Stringable a where
stFromString :: String -> a
stToString :: a -> String
mconcatMap :: [b] -> (b -> a) -> a
mconcatMap m k = foldr (mappend . k) mempty m
mintercalate :: a -> [a] -> a
mintercalate = (mconcat .) . intersperse
mlabel :: a -> a -> a
mlabel x y = mconcat [x, stFromString "[", y, stFromString "]"]
instance Stringable [Char] where
stFromString = id
stToString = id
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)
instance Monoid PP.Doc where
mempty = PP.empty
x `mappend` y = x PP.<> y
instance Stringable B.ByteString where
stFromString = B.pack
stToString = B.unpack
instance Stringable LB.ByteString where
stFromString = LB.pack
stToString = LB.unpack
instance Stringable (Endo String) where
stFromString = Endo . (++)
stToString = ($ []) . appEndo