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 FormatAscii a where
type FormatAscii' a
formatAscii :: a -> FormatAscii' a
data Plain a
= Plain a
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
(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 #-}
instance FormatAscii Int where
type FormatAscii' Int = IntAsc
formatAscii :: Int -> FormatAscii' Int
formatAscii Int
_ = IntAsc
FormatAscii' Int
IntAsc
{-# INLINE formatAscii #-}
instance FormatAscii Double where
type FormatAscii' Double = DoubleAsc
formatAscii :: Double -> FormatAscii' Double
formatAscii Double
_ = DoubleAsc
FormatAscii' Double
DoubleAsc
{-# INLINE formatAscii #-}
instance FormatAscii String where
type FormatAscii' String = VarCharString
formatAscii :: [Char] -> FormatAscii' [Char]
formatAscii [Char]
_ = VarCharString
FormatAscii' [Char]
VarCharString
{-# INLINE formatAscii #-}
instance FormatAscii Date32 where
type FormatAscii' Date32 = YYYYsMMsDD
formatAscii :: Date32 -> FormatAscii' Date32
formatAscii Date32
_ = Char -> YYYYsMMsDD
YYYYsMMsDD Char
'-'
{-# INLINE formatAscii #-}