module Data.Repa.Convert.Format.Ascii
        (FormatAscii (..))
where
import Data.Repa.Convert.Format.Numeric
import Data.Repa.Convert.Format.String
import Data.Repa.Convert.Format.Date32
import Data.Repa.Scalar.Date32                  (Date32)
import Data.Repa.Scalar.Product
#include "repa-convert.h"


-- | Class of types that can be formatted in some default human readable
--   ASCII way.
class FormatAscii a where
 -- | The format for values of this type.
 type FormatAscii' a 

 -- | Get the standard ASCII format for a value.
 --
 --   The element value itself is not demanded.
 --
 formatAscii :: a -> FormatAscii' a

data Plain a 
        = Plain a


-- | Empty tuples produce no output.
instance FormatAscii () where
 type FormatAscii' ()     = ()
 formatAscii :: () -> FormatAscii' ()
formatAscii ()
_            = ()
 {-# INLINE formatAscii #-}


instance FormatAscii (Plain ()) where
 type FormatAscii'   (Plain ())          = ()
 formatAscii :: Plain () -> FormatAscii' (Plain ())
formatAscii         (Plain ()
_)           = ()
 {-# INLINE formatAscii #-}


instance (FormatAscii t1, FormatAscii (Plain ts))
      => FormatAscii (Plain (t1 :*: ts)) where
 type FormatAscii'   (Plain (t1 :*: ts)) 
  = FormatAscii' t1 :*: FormatAscii' (Plain ts)

 formatAscii :: Plain (t1 :*: ts) -> FormatAscii' (Plain (t1 :*: ts))
formatAscii Plain (t1 :*: ts)
_
  = let -- The values of these type proxies should never be demanded.
        (t1
x1_proxy :: t1)  = [Char] -> t1
forall a. HasCallStack => [Char] -> a
error [Char]
"repa-convert: formatAscii proxy"
        (ts
xs_proxy :: ts)  = [Char] -> ts
forall a. HasCallStack => [Char] -> a
error [Char]
"repa-convert: formatAscii proxy"
    in  t1 -> FormatAscii' t1
forall a. FormatAscii a => a -> FormatAscii' a
formatAscii  t1
x1_proxy FormatAscii' t1
-> FormatAscii' (Plain ts)
-> FormatAscii' t1 :*: FormatAscii' (Plain ts)
forall a b. a -> b -> a :*: b
:*: Plain ts -> FormatAscii' (Plain ts)
forall a. FormatAscii a => a -> FormatAscii' a
formatAscii (ts -> Plain ts
forall a. a -> Plain a
Plain ts
xs_proxy)
 {-# NOINLINE formatAscii #-}
 
 
-- | Ints are formated in base-10.
instance FormatAscii  Int where
 type FormatAscii' Int    = IntAsc
 formatAscii :: Int -> FormatAscii' Int
formatAscii Int
_            = IntAsc
FormatAscii' Int
IntAsc
 {-# INLINE formatAscii #-}


-- | Doubles are formatted as base-10 decimal.
instance FormatAscii  Double where
 type FormatAscii' Double = DoubleAsc
 formatAscii :: Double -> FormatAscii' Double
formatAscii Double
_            = DoubleAsc
FormatAscii' Double
DoubleAsc
 {-# INLINE formatAscii #-}


-- | Strings are formatted with double quotes and back-slash escaping
--   of special characters.
instance FormatAscii  String where
 type FormatAscii' String = VarCharString
 formatAscii :: [Char] -> FormatAscii' [Char]
formatAscii [Char]
_            = VarCharString
FormatAscii' [Char]
VarCharString
 {-# INLINE formatAscii #-}


-- | Dates are formatted as YYYY-MM-DD.
instance FormatAscii  Date32 where
 type FormatAscii' Date32 = YYYYsMMsDD
 formatAscii :: Date32 -> FormatAscii' Date32
formatAscii Date32
_            = Char -> YYYYsMMsDD
YYYYsMMsDD Char
'-'
 {-# INLINE formatAscii #-}