HStringTemplate-0.6.11: Text/StringTemplate/Instances.hs

{-# LANGUAGE FlexibleInstances, OverlappingInstances, CPP #-}
#ifdef GENERICS
{-# LANGUAGE DefaultSignatures, DeriveGeneric, TypeOperators #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

module Text.StringTemplate.Instances where
--module Text.StringTemplate.Instances() where
import Text.StringTemplate.Classes

import qualified Data.Map as M
import Numeric
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Ratio
import Data.Array
import Data.Maybe
import qualified Data.Foldable as F
import qualified System.Time as OldTime
import System.Locale
import Data.Time
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
#ifdef GENERICS
import GHC.Generics
#endif
import Debug.Trace

{--------------------------------------------------------------------
  Additional instances for items that may be set as StringTemplate
  attributes. The code should provide examples of how to proceed.
--------------------------------------------------------------------}

--Basics

instance Stringable a => ToSElem (SElem a) where
    toSElem (STR s)  = STR s
    toSElem (BS x)   = BS x
    toSElem (STSH x) = STSH x
    toSElem (SM x)   = SM $ M.map toSElem x
    toSElem (LI xs)  = LI $ map toSElem xs
    toSElem (SBLE x) = STR $ stToString x
    toSElem (SNAT x) = STR $ stToString x
    toSElem SNull = SNull

instance ToSElem Char where
    toSElem = STR . (:[])
    toSElemList = STR

instance ToSElem LB.ByteString where
    toSElem = BS

instance ToSElem B.ByteString where
    toSElem = BS . LB.fromChunks . (:[])

instance ToSElem LT.Text where
    toSElem = BS . LT.encodeUtf8

instance ToSElem T.Text where
    toSElem = BS . LB.fromChunks . (:[]) . T.encodeUtf8

instance ToSElem Bool where
    toSElem True = STR ""
    toSElem _ = SNull

instance (ToSElem a) => ToSElem (Maybe a) where
    toSElem (Just x) = toSElem x
    toSElem _ = SNull

instance (ToSElem a) => ToSElem (M.Map String a) where
    toSElem = SM . fmap toSElem

instance (ToSElem a) => ToSElem [a] where
    toSElem = toSElemList

instance (ToSElem a, Ix i) => ToSElem (Array i a) where
   toSElem = toSElem . elems

instance (ToSElem a, F.Foldable t) => ToSElem (t a) where
    toSElem = toSElemList . F.toList

--Numbers
instance StringTemplateShows Float where
    stringTemplateShow = flip showFloat ""
    stringTemplateFormattedShow = flip flip [] . showGFloat . fmap fst . listToMaybe . reads
instance ToSElem Float where
    toSElem = stShowsToSE

instance StringTemplateShows Double where
    stringTemplateShow = flip showFloat ""
    stringTemplateFormattedShow = flip flip [] . showGFloat . fmap fst . listToMaybe . reads
instance ToSElem Double where
    toSElem = stShowsToSE

instance ToSElem Int where
    toSElem = STR . show

instance ToSElem Integer where
    toSElem = STR . show

instance (Integral a, Show a) => ToSElem (Ratio a) where
    toSElem = STR . show

--Dates and Times
instance StringTemplateShows OldTime.CalendarTime where
    stringTemplateShow = OldTime.calendarTimeToString
    stringTemplateFormattedShow = OldTime.formatCalendarTime defaultTimeLocale
instance ToSElem OldTime.CalendarTime where
    toSElem = stShowsToSE

instance StringTemplateShows OldTime.TimeDiff where
    stringTemplateShow = OldTime.timeDiffToString
    stringTemplateFormattedShow = OldTime.formatTimeDiff defaultTimeLocale
instance ToSElem OldTime.TimeDiff where
    toSElem = stShowsToSE

instance StringTemplateShows Day where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem Day where
    toSElem = stShowsToSE

instance StringTemplateShows LocalTime where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem LocalTime where
    toSElem = stShowsToSE

instance StringTemplateShows TimeOfDay where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem TimeOfDay where
    toSElem = stShowsToSE

instance StringTemplateShows UTCTime where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem UTCTime where
    toSElem = stShowsToSE

instance StringTemplateShows TimeZone where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem TimeZone where
    toSElem = stShowsToSE

instance StringTemplateShows ZonedTime where
    stringTemplateShow = show
    stringTemplateFormattedShow = formatTime defaultTimeLocale
instance ToSElem ZonedTime where
    toSElem = stShowsToSE

t2map :: [SElem a] -> SElem a
t2map = SM . M.fromList . zip (map show [(0::Int)..])

instance (ToSElem a, ToSElem b) => ToSElem (a, b) where
   toSElem (a,b) = t2map [toSElem a, toSElem b]
instance (ToSElem a, ToSElem b, ToSElem c) => ToSElem (a, b, c) where
   toSElem (a,b,c) = t2map [toSElem a, toSElem b, toSElem c]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d) => ToSElem (a, b, c, d) where
   toSElem (a,b,c,d) = t2map [toSElem a, toSElem b, toSElem c, toSElem d]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e) => ToSElem (a, b, c, d, e) where
   toSElem (a,b,c,d,e) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e, ToSElem f) => ToSElem (a, b, c, d, e, f) where
   toSElem (a,b,c,d,e, f) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e, toSElem f]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e, ToSElem f, ToSElem g) => ToSElem (a, b, c, d, e, f, g) where
   toSElem (a,b,c,d,e,f,g) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e, toSElem f, toSElem g]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e, ToSElem f, ToSElem g, ToSElem h) => ToSElem (a, b, c, d, e, f, g, h) where
   toSElem (a,b,c,d,e,f,g,h) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e, toSElem f, toSElem g, toSElem h]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e, ToSElem f, ToSElem g, ToSElem h, ToSElem i) => ToSElem (a, b, c, d, e, f, g, h, i) where
   toSElem (a,b,c,d,e,f,g,h,i) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e, toSElem f, toSElem g, toSElem h, toSElem i]
instance (ToSElem a, ToSElem b, ToSElem c, ToSElem d, ToSElem e, ToSElem f, ToSElem g, ToSElem h, ToSElem i, ToSElem j) => ToSElem (a, b, c, d, e, f, g, h, i, j) where
   toSElem (a,b,c,d,e,f,g,h,i,j) = t2map [toSElem a, toSElem b, toSElem c, toSElem d, toSElem e, toSElem f, toSElem g, toSElem h, toSElem i, toSElem j]


---
#ifdef GENERICS
instance GToSElem V1
    where gToSElem = const SNull
instance GToSElem U1
    where gToSElem = const $ STR ""
instance  ToSElem a => GToSElem (K1 i a)
    where gToSElem = toSElem . unK1
-- instance GToSElem a => GToSElem (M1 i c a)
--    where gToSElem = gToSElem . unM1
instance (Constructor c, GToSElem a) => GToSElem (C1 c a)
    where gToSElem x = (gToSElem (unM1 x))
instance GToSElem a => GToSElem (D1 dt a)
    where gToSElem = gToSElem . unM1
instance (Selector s, GToSElem a) => GToSElem (S1 s a)
    where gToSElem x = (gToSElem (unM1 x))
instance (GToSElem a, GToSElem b) => GToSElem (a :*: b)
    where gToSElem (x :*: y) = trace "ay" $ LI [gToSElem x, gToSElem y] -- recursively recover
instance (GToSElem a, GToSElem b) => GToSElem (a :+: b) -- ditto
    where gToSElem (L1 x) = gToSElem x
          gToSElem (R1 x) = gToSElem x

-- TODO special case tuple, list, maybe

data Foo a b = Baz {aasdf :: a, dfdfd :: b, dddd :: String} | Bar deriving Generic

#endif