    {-# LANGUAGE ExistentialQuantification, FlexibleInstances, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeSynonymInstances #-}
    {-# OPTIONS_HADDOCK not-home #-}
    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 Blaze.ByteString.Builder as BB
    import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
    import qualified Data.ByteString.Char8 as B
    import qualified Data.ByteString.Lazy.Char8 as LB
    --import qualified Data.ByteString.Lazy.Builder as DBB
    import qualified Data.Semigroup as SG
    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.Builder as TB
    import qualified Data.Text.Lazy.Encoding as LT
    import qualified Text.PrettyPrint.HughesPJ as PP

    newtype StFirst a = StFirst { forall a. StFirst a -> Maybe a
    stGetFirst :: Maybe a }
            deriving (StFirst a -> StFirst a -> Bool
    (StFirst a -> StFirst a -> Bool)
    -> (StFirst a -> StFirst a -> Bool) -> Eq (StFirst a)
    forall a. Eq a => StFirst a -> StFirst a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => StFirst a -> StFirst a -> Bool
    == :: StFirst a -> StFirst a -> Bool
    $c/= :: forall a. Eq a => StFirst a -> StFirst a -> Bool
    /= :: StFirst a -> StFirst a -> Bool
    Eq, Eq (StFirst a)
    Eq (StFirst a) =>
    (StFirst a -> StFirst a -> Ordering)
    -> (StFirst a -> StFirst a -> Bool)
    -> (StFirst a -> StFirst a -> Bool)
    -> (StFirst a -> StFirst a -> Bool)
    -> (StFirst a -> StFirst a -> Bool)
    -> (StFirst a -> StFirst a -> StFirst a)
    -> (StFirst a -> StFirst a -> StFirst a)
    -> Ord (StFirst a)
    StFirst a -> StFirst a -> Bool
    StFirst a -> StFirst a -> Ordering
    StFirst a -> StFirst a -> StFirst a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (StFirst a)
    forall a. Ord a => StFirst a -> StFirst a -> Bool
    forall a. Ord a => StFirst a -> StFirst a -> Ordering
    forall a. Ord a => StFirst a -> StFirst a -> StFirst a
    $ccompare :: forall a. Ord a => StFirst a -> StFirst a -> Ordering
    compare :: StFirst a -> StFirst a -> Ordering
    $c< :: forall a. Ord a => StFirst a -> StFirst a -> Bool
    < :: StFirst a -> StFirst a -> Bool
    $c<= :: forall a. Ord a => StFirst a -> StFirst a -> Bool
    <= :: StFirst a -> StFirst a -> Bool
    $c> :: forall a. Ord a => StFirst a -> StFirst a -> Bool
    > :: StFirst a -> StFirst a -> Bool
    $c>= :: forall a. Ord a => StFirst a -> StFirst a -> Bool
    >= :: StFirst a -> StFirst a -> Bool
    $cmax :: forall a. Ord a => StFirst a -> StFirst a -> StFirst a
    max :: StFirst a -> StFirst a -> StFirst a
    $cmin :: forall a. Ord a => StFirst a -> StFirst a -> StFirst a
    min :: StFirst a -> StFirst a -> StFirst a
    Ord, ReadPrec [StFirst a]
    ReadPrec (StFirst a)
    Int -> ReadS (StFirst a)
    ReadS [StFirst a]
    (Int -> ReadS (StFirst a))
    -> ReadS [StFirst a]
    -> ReadPrec (StFirst a)
    -> ReadPrec [StFirst a]
    -> Read (StFirst a)
    forall a. Read a => ReadPrec [StFirst a]
    forall a. Read a => ReadPrec (StFirst a)
    forall a. Read a => Int -> ReadS (StFirst a)
    forall a. Read a => ReadS [StFirst a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (StFirst a)
    readsPrec :: Int -> ReadS (StFirst a)
    $creadList :: forall a. Read a => ReadS [StFirst a]
    readList :: ReadS [StFirst a]
    $creadPrec :: forall a. Read a => ReadPrec (StFirst a)
    readPrec :: ReadPrec (StFirst a)
    $creadListPrec :: forall a. Read a => ReadPrec [StFirst a]
    readListPrec :: ReadPrec [StFirst a]
    Read, Int -> StFirst a -> ShowS
    [StFirst a] -> ShowS
    StFirst a -> String
    (Int -> StFirst a -> ShowS)
    -> (StFirst a -> String)
    -> ([StFirst a] -> ShowS)
    -> Show (StFirst a)
    forall a. Show a => Int -> StFirst a -> ShowS
    forall a. Show a => [StFirst a] -> ShowS
    forall a. Show a => StFirst a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> StFirst a -> ShowS
    showsPrec :: Int -> StFirst a -> ShowS
    $cshow :: forall a. Show a => StFirst a -> String
    show :: StFirst a -> String
    $cshowList :: forall a. Show a => [StFirst a] -> ShowS
    showList :: [StFirst a] -> ShowS
    Show)
    instance SG.Semigroup (StFirst a) where
            r :: StFirst a
    r@(StFirst (Just a
    _)) <> :: StFirst a -> StFirst a -> StFirst a
    <> StFirst a
    _ = StFirst a
    r
            StFirst Maybe a
    Nothing      <> StFirst a
    r = StFirst a
    r
    instance Monoid (StFirst a) where
            mempty :: StFirst a
    mempty  = Maybe a -> StFirst a
    forall a. Maybe a -> StFirst a
    StFirst Maybe a
    forall a. Maybe a
    Nothing
            mappend :: StFirst a -> StFirst a -> StFirst a
    mappend = StFirst a -> StFirst a -> StFirst a
    forall a. Semigroup a => a -> a -> a
    (SG.<>)

    instance Functor StFirst where
        fmap :: forall a b. (a -> b) -> StFirst a -> StFirst b
    fmap a -> b
    f = Maybe b -> StFirst b
    forall a. Maybe a -> StFirst a
    StFirst (Maybe b -> StFirst b)
    -> (StFirst a -> Maybe b) -> StFirst a -> StFirst b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Maybe a -> Maybe b)
    -> (StFirst a -> Maybe a) -> StFirst a -> Maybe b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StFirst a -> Maybe a
    forall a. StFirst a -> Maybe a
    stGetFirst

    type SMap a = M.Map String (SElem a)

    data SElem a = STR  String
                 | BS   LB.ByteString
                 | TXT  LT.Text
                 | STSH STShow
                 | SM (SMap a)
                 | LI [SElem a]
                 | SBLE a
                 | SNAT a
                 | SNull

    -- | The ToSElem class should be instantiated for all types that can be
    -- inserted as attributes into a StringTemplate.
    class ToSElem a where
        toSElem :: Stringable b => a -> SElem b
        toSElemList :: Stringable b => [a] -> SElem b
        toSElemList = [SElem b] -> SElem b
    forall a. [SElem a] -> SElem a
    LI ([SElem b] -> SElem b) -> ([a] -> [SElem b]) -> [a] -> SElem b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> SElem b) -> [a] -> [SElem b]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> SElem b
    forall b. Stringable b => a -> SElem b
    forall a b. (ToSElem a, Stringable b) => a -> SElem b
    toSElem

    -- | The StringTemplateShows class should be instantiated for all types that are
    -- directly displayed in a StringTemplate, but take an optional format string. Each such type must have an appropriate ToSElem method defined as well.
    class (Show a) => StringTemplateShows a where
        -- | Defaults to 'show'.
        stringTemplateShow :: a -> String
        stringTemplateShow = a -> String
    forall a. Show a => a -> String
    show
        -- | Defaults to  @ \ _ a -> stringTemplateShow a @
        stringTemplateFormattedShow :: String -> a -> String
        stringTemplateFormattedShow = (a -> ShowS) -> String -> a -> String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((a -> ShowS) -> String -> a -> String)
    -> (a -> ShowS) -> String -> a -> String
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall a b. a -> b -> a
    const (String -> ShowS) -> (a -> String) -> a -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. StringTemplateShows a => a -> String
    stringTemplateShow

    -- | This method should be used to create ToSElem instances for
    -- types defining a custom formatted show function.
    stShowsToSE :: (StringTemplateShows a, Stringable b) => a -> SElem b
    stShowsToSE :: forall a b. (StringTemplateShows a, Stringable b) => a -> SElem b
    stShowsToSE = STShow -> SElem b
    forall a. STShow -> SElem a
    STSH (STShow -> SElem b) -> (a -> STShow) -> a -> SElem b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> STShow
    forall a. StringTemplateShows a => a -> STShow
    STShow

    data STShow = forall a.(StringTemplateShows a) => STShow a

    -- | The Stringable class should be instantiated with care.
    -- Generally, the provided instances should be enough for anything.
    class Monoid a => Stringable a where
        stFromString :: String -> a
        stFromByteString :: LB.ByteString -> a
        stFromByteString = Text -> a
    forall a. Stringable a => Text -> a
    stFromText (Text -> a) -> (ByteString -> Text) -> ByteString -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    LT.decodeUtf8
        stFromText :: LT.Text -> a
        stFromText = String -> a
    forall a. Stringable a => String -> a
    stFromString (String -> a) -> (Text -> String) -> Text -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    LT.unpack
        stToString :: a -> String
        -- | Defaults to  @ mconcatMap m k = foldr (mappend . k) mempty m @
        mconcatMap :: [b] -> (b -> a) -> a
        mconcatMap [b]
    m b -> a
    k = (b -> a -> a) -> a -> [b] -> a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend (a -> a -> a) -> (b -> a) -> b -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    k) a
    forall a. Monoid a => a
    mempty [b]
    m
        -- | Defaults to  @ (mconcat .) . intersperse @
        mintercalate :: a -> [a] -> a
        mintercalate = ([a] -> a
    forall a. Monoid a => [a] -> a
    mconcat ([a] -> a) -> ([a] -> [a]) -> [a] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) (([a] -> [a]) -> [a] -> a) -> (a -> [a] -> [a]) -> a -> [a] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    intersperse
        -- | Defaults to  @  mlabel x y = mconcat [x, stFromString "[", y, stFromString "]"] @
        mlabel :: a -> a -> a
        mlabel a
    x a
    y = [a] -> a
    forall a. Monoid a => [a] -> a
    mconcat [a
    x, String -> a
    forall a. Stringable a => String -> a
    stFromString String
    "[", a
    y, String -> a
    forall a. Stringable a => String -> a
    stFromString String
    "]"]

    instance Stringable String where
        stFromString :: ShowS
    stFromString = ShowS
    forall a. a -> a
    id
        stToString :: ShowS
    stToString = ShowS
    forall a. a -> a
    id

    instance Stringable PP.Doc where
        stFromString :: String -> Doc
    stFromString = String -> Doc
    PP.text
        stToString :: Doc -> String
    stToString = Doc -> String
    PP.render
        mconcatMap :: forall b. [b] -> (b -> Doc) -> Doc
    mconcatMap [b]
    m b -> Doc
    k = [Doc] -> Doc
    PP.fcat ([Doc] -> Doc) -> ([b] -> [Doc]) -> [b] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Doc) -> [b] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map b -> Doc
    k ([b] -> Doc) -> [b] -> Doc
    forall a b. (a -> b) -> a -> b
    $ [b]
    m
        mintercalate :: Doc -> [Doc] -> Doc
    mintercalate = ([Doc] -> Doc
    PP.fcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) (([Doc] -> [Doc]) -> [Doc] -> Doc)
    -> (Doc -> [Doc] -> [Doc]) -> Doc -> [Doc] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc -> [Doc] -> [Doc]
    PP.punctuate
        mlabel :: Doc -> Doc -> Doc
    mlabel Doc
    x Doc
    y = Doc
    x Doc -> Doc -> Doc
    PP.$$ Int -> Doc -> Doc
    PP.nest Int
    1 Doc
    y

    instance Stringable B.ByteString where
        stFromString :: String -> ByteString
    stFromString = String -> ByteString
    B.pack
        stFromByteString :: ByteString -> ByteString
    stFromByteString = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    LB.toChunks
        stToString :: ByteString -> String
    stToString = ByteString -> String
    B.unpack

    instance Stringable LB.ByteString where
        stFromString :: String -> ByteString
    stFromString = String -> ByteString
    LB.pack
        stFromByteString :: ByteString -> ByteString
    stFromByteString = ByteString -> ByteString
    forall a. a -> a
    id
        stToString :: ByteString -> String
    stToString = ByteString -> String
    LB.unpack

    instance Stringable T.Text where
        stFromString :: String -> Text
    stFromString = String -> Text
    T.pack
        stFromByteString :: ByteString -> Text
    stFromByteString = ByteString -> Text
    T.decodeUtf8 (ByteString -> Text)
    -> (ByteString -> ByteString) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    LB.toChunks
        stFromText :: Text -> Text
    stFromText = Text -> Text
    LT.toStrict
        stToString :: Text -> String
    stToString = Text -> String
    T.unpack

    instance Stringable LT.Text where
        stFromString :: String -> Text
    stFromString = String -> Text
    LT.pack
        stFromByteString :: ByteString -> Text
    stFromByteString = ByteString -> Text
    LT.decodeUtf8
        stFromText :: Text -> Text
    stFromText = Text -> Text
    forall a. a -> a
    id
        stToString :: Text -> String
    stToString = Text -> String
    LT.unpack

    instance Stringable BB.Builder where
        stFromString :: String -> Builder
    stFromString = String -> Builder
    BB.fromString
        stFromByteString :: ByteString -> Builder
    stFromByteString = ByteString -> Builder
    BB.fromLazyByteString
        stToString :: Builder -> String
    stToString = ByteString -> String
    LB.unpack (ByteString -> String)
    -> (Builder -> ByteString) -> Builder -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> ByteString
    BB.toLazyByteString

    {-
    instance Stringable LBB.Builder where
        stFromString = stringUtf8
        stFromByteString = LBB.lazyByteString
        stToString = LB.unpack . LBB.toLazyByteString
    -}

    instance Stringable TB.Builder where
        stFromString :: String -> Builder
    stFromString = String -> Builder
    TB.fromString
        stFromText :: Text -> Builder
    stFromText = Text -> Builder
    TB.fromLazyText
        stToString :: Builder -> String
    stToString = Text -> String
    LT.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> Text
    TB.toLazyText

    --add dlist instance
    instance Stringable (Endo String) where
        stFromString :: String -> Endo String
    stFromString = ShowS -> Endo String
    forall a. (a -> a) -> Endo a
    Endo (ShowS -> Endo String)
    -> (String -> ShowS) -> String -> Endo String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++)
        stToString :: Endo String -> String
    stToString = (ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ []) (ShowS -> String)
    -> (Endo String -> ShowS) -> Endo String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Endo String -> ShowS
    forall a. Endo a -> a -> a
    appEndo