-- | 'Texy' class, as proposed in <http://deltadiaz.blogspot.com.es/2013/04/hatex-36-proposal-texy-class.html>.
module Text.LaTeX.Base.Texy (
   -- * Texy class
   Texy (..)
 ) where

import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Class
import Text.LaTeX.Base.Render
--
import Numeric
import Data.Fixed

-- | Class of types that can be pretty-printed as 'LaTeX' values.
class Texy t where
 texy :: LaTeXC l => t -> l

-- Basic instances

instance Texy LaTeX where
 texy :: LaTeX -> l
texy = LaTeX -> l
forall l. LaTeXC l => LaTeX -> l
fromLaTeX

instance Texy Text where
 texy :: Text -> l
texy = LaTeX -> l
forall l. LaTeXC l => LaTeX -> l
fromLaTeX (LaTeX -> l) -> (Text -> LaTeX) -> Text -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LaTeX
TeXRaw (Text -> LaTeX) -> (Text -> Text) -> Text -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
protectText

instance Texy Int where
 texy :: Int -> l
texy = Int -> l
forall a l. (Render a, LaTeXC l) => a -> l
rendertex

instance Texy Integer where
 texy :: Integer -> l
texy = Integer -> l
forall a l. (Render a, LaTeXC l) => a -> l
rendertex

instance Texy Float where
 texy :: Float -> l
texy Float
x = String -> l
forall a. IsString a => String -> a
fromString (String -> l) -> String -> l
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Float
x String
""

instance Texy Double where
 texy :: Double -> l
texy Double
x = String -> l
forall a. IsString a => String -> a
fromString (String -> l) -> String -> l
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat Maybe Int
forall a. Maybe a
Nothing Double
x String
""

instance Texy Char where
 texy :: Char -> l
texy Char
c = String -> l
forall a. IsString a => String -> a
fromString [Char
'`' , Char
c , Char
'`']

instance HasResolution a => Texy (Fixed a) where
 texy :: Fixed a -> l
texy = String -> l
forall a. IsString a => String -> a
fromString (String -> l) -> (Fixed a -> String) -> Fixed a -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed a -> String
forall a. Show a => a -> String
show

instance Texy Bool where
 texy :: Bool -> l
texy = String -> l
forall a. IsString a => String -> a
fromString (String -> l) -> (Bool -> String) -> Bool -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show

instance Texy Measure where
 texy :: Measure -> l
texy = Measure -> l
forall a l. (Render a, LaTeXC l) => a -> l
rendertex