{- |
Provide a class that renders multiple Haskell values in a text form
that is accessible by gnuplot.

Maybe we add a method for the binary interface to gnuplot later.
-}
module Graphics.Gnuplot.Value.Tuple (
   C(text, columnCount),
   ColumnCount(ColumnCount),
   Label(Label),
   ) where

import Graphics.Gnuplot.Utility (quote)

import Data.Time.Format (defaultTimeLocale, )
import qualified Data.Time as Time

import Data.Word (Word8, Word16, Word32, Word64, )
import Data.Int (Int8, Int16, Int32, Int64, )
import Data.Ratio (Ratio, )

import Data.Function (id, ($), (.), )
import Text.Show (Show, ShowS, shows, showString, )
import Prelude
         (Eq, Ord, String, Int, Integer, Integral, Float, Double,
          realToFrac, (+), (++), )


class C a where
   {- |
   For values that are also in Atom class,
   'text' must generate a singleton list.
   -}
   text :: a -> [ShowS]

   {- |
   It must hold @ColumnCount (length (text x)) == columnCount@.
   -}
   columnCount :: ColumnCount a
   columnCount = Int -> ColumnCount a
forall a. Int -> ColumnCount a
ColumnCount Int
1

{- |
Count numbers of gnuplot data columns for the respective type.

Somehow a writer monad with respect to Sum monoid
without material monadic result.

Cf. ColumnSet module.
-}
newtype ColumnCount a = ColumnCount Int
   deriving (ColumnCount a -> ColumnCount a -> Bool
(ColumnCount a -> ColumnCount a -> Bool)
-> (ColumnCount a -> ColumnCount a -> Bool) -> Eq (ColumnCount a)
forall a. ColumnCount a -> ColumnCount a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnCount a -> ColumnCount a -> Bool
$c/= :: forall a. ColumnCount a -> ColumnCount a -> Bool
== :: ColumnCount a -> ColumnCount a -> Bool
$c== :: forall a. ColumnCount a -> ColumnCount a -> Bool
Eq, Eq (ColumnCount a)
Eq (ColumnCount a)
-> (ColumnCount a -> ColumnCount a -> Ordering)
-> (ColumnCount a -> ColumnCount a -> Bool)
-> (ColumnCount a -> ColumnCount a -> Bool)
-> (ColumnCount a -> ColumnCount a -> Bool)
-> (ColumnCount a -> ColumnCount a -> Bool)
-> (ColumnCount a -> ColumnCount a -> ColumnCount a)
-> (ColumnCount a -> ColumnCount a -> ColumnCount a)
-> Ord (ColumnCount a)
ColumnCount a -> ColumnCount a -> Bool
ColumnCount a -> ColumnCount a -> Ordering
ColumnCount a -> ColumnCount a -> ColumnCount a
forall a. Eq (ColumnCount 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. ColumnCount a -> ColumnCount a -> Bool
forall a. ColumnCount a -> ColumnCount a -> Ordering
forall a. ColumnCount a -> ColumnCount a -> ColumnCount a
min :: ColumnCount a -> ColumnCount a -> ColumnCount a
$cmin :: forall a. ColumnCount a -> ColumnCount a -> ColumnCount a
max :: ColumnCount a -> ColumnCount a -> ColumnCount a
$cmax :: forall a. ColumnCount a -> ColumnCount a -> ColumnCount a
>= :: ColumnCount a -> ColumnCount a -> Bool
$c>= :: forall a. ColumnCount a -> ColumnCount a -> Bool
> :: ColumnCount a -> ColumnCount a -> Bool
$c> :: forall a. ColumnCount a -> ColumnCount a -> Bool
<= :: ColumnCount a -> ColumnCount a -> Bool
$c<= :: forall a. ColumnCount a -> ColumnCount a -> Bool
< :: ColumnCount a -> ColumnCount a -> Bool
$c< :: forall a. ColumnCount a -> ColumnCount a -> Bool
compare :: ColumnCount a -> ColumnCount a -> Ordering
$ccompare :: forall a. ColumnCount a -> ColumnCount a -> Ordering
$cp1Ord :: forall a. Eq (ColumnCount a)
Ord, Int -> ColumnCount a -> ShowS
[ColumnCount a] -> ShowS
ColumnCount a -> String
(Int -> ColumnCount a -> ShowS)
-> (ColumnCount a -> String)
-> ([ColumnCount a] -> ShowS)
-> Show (ColumnCount a)
forall a. Int -> ColumnCount a -> ShowS
forall a. [ColumnCount a] -> ShowS
forall a. ColumnCount a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnCount a] -> ShowS
$cshowList :: forall a. [ColumnCount a] -> ShowS
show :: ColumnCount a -> String
$cshow :: forall a. ColumnCount a -> String
showsPrec :: Int -> ColumnCount a -> ShowS
$cshowsPrec :: forall a. Int -> ColumnCount a -> ShowS
Show)

{-
Functor and Applicative instances would be useful
for combining column sets,
but they are dangerous, because they can bring
type and column columnCount out of sync.
-}

pure :: a -> ColumnCount a
pure :: a -> ColumnCount a
pure a
_ = Int -> ColumnCount a
forall a. Int -> ColumnCount a
ColumnCount Int
0

(<*>) :: ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
ColumnCount Int
n <*> :: ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount Int
m = Int -> ColumnCount b
forall a. Int -> ColumnCount a
ColumnCount (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
m)


singleton :: a -> [a]
singleton :: a -> [a]
singleton = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])


instance C Float   where text :: Float -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Float -> ShowS) -> Float -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Double  where text :: Double -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Double -> ShowS) -> Double -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Int     where text :: Int -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Int -> ShowS) -> Int -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Integer where text :: Integer -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Integer -> ShowS) -> Integer -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows
instance (Integral a) => C (Ratio a) where
   text :: Ratio a -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Ratio a -> ShowS) -> Ratio a -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ShowS
forall a. Show a => a -> ShowS
shows (Double -> ShowS) -> (Ratio a -> Double) -> Ratio a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double
forall a. a -> a
id :: Double->Double) (Double -> Double) -> (Ratio a -> Double) -> Ratio a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance C Int8  where text :: Int8 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Int8 -> ShowS) -> Int8 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Int16 where text :: Int16 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Int16 -> ShowS) -> Int16 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Int32 where text :: Int32 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Int32 -> ShowS) -> Int32 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Int64 where text :: Int64 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Int64 -> ShowS) -> Int64 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Word8  where text :: Word8 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Word8 -> ShowS) -> Word8 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Word16 where text :: Word16 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Word16 -> ShowS) -> Word16 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Word32 where text :: Word32 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Word32 -> ShowS) -> Word32 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows
instance C Word64 where text :: Word64 -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (Word64 -> ShowS) -> Word64 -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Show a => a -> ShowS
shows

instance C Time.Day where
   text :: Day -> [ShowS]
text Day
d = UTCTime -> [ShowS]
forall a. C a => a -> [ShowS]
text (UTCTime -> [ShowS]) -> UTCTime -> [ShowS]
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
Time.UTCTime Day
d DiffTime
0
instance C Time.UTCTime where
   text :: UTCTime -> [ShowS]
text = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> (UTCTime -> ShowS) -> UTCTime -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (String -> ShowS) -> (UTCTime -> String) -> UTCTime -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale String
"%s"

newtype Label = Label String
instance C Label where text :: Label -> [ShowS]
text (Label String
str) = ShowS -> [ShowS]
forall a. a -> [a]
singleton (ShowS -> [ShowS]) -> ShowS -> [ShowS]
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
quote String
str


instance (C a, C b) => C (a,b) where
   text :: (a, b) -> [ShowS]
text (a
a,b
b) = a -> [ShowS]
forall a. C a => a -> [ShowS]
text a
a [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ b -> [ShowS]
forall a. C a => a -> [ShowS]
text b
b
   columnCount :: ColumnCount (a, b)
columnCount =
      (a -> b -> (a, b)) -> ColumnCount (a -> b -> (a, b))
forall a. a -> ColumnCount a
pure (,)
         ColumnCount (a -> b -> (a, b))
-> ColumnCount a -> ColumnCount (b -> (a, b))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount a
forall a. C a => ColumnCount a
columnCount
         ColumnCount (b -> (a, b)) -> ColumnCount b -> ColumnCount (a, b)
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount b
forall a. C a => ColumnCount a
columnCount

instance (C a, C b, C c) => C (a,b,c) where
   text :: (a, b, c) -> [ShowS]
text (a
a,b
b,c
c) = a -> [ShowS]
forall a. C a => a -> [ShowS]
text a
a [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ b -> [ShowS]
forall a. C a => a -> [ShowS]
text b
b [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ c -> [ShowS]
forall a. C a => a -> [ShowS]
text c
c
   columnCount :: ColumnCount (a, b, c)
columnCount =
      (a -> b -> c -> (a, b, c))
-> ColumnCount (a -> b -> c -> (a, b, c))
forall a. a -> ColumnCount a
pure (,,)
         ColumnCount (a -> b -> c -> (a, b, c))
-> ColumnCount a -> ColumnCount (b -> c -> (a, b, c))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount a
forall a. C a => ColumnCount a
columnCount
         ColumnCount (b -> c -> (a, b, c))
-> ColumnCount b -> ColumnCount (c -> (a, b, c))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount b
forall a. C a => ColumnCount a
columnCount
         ColumnCount (c -> (a, b, c))
-> ColumnCount c -> ColumnCount (a, b, c)
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount c
forall a. C a => ColumnCount a
columnCount

instance (C a, C b, C c, C d) => C (a,b,c,d) where
   text :: (a, b, c, d) -> [ShowS]
text (a
a,b
b,c
c,d
d) = a -> [ShowS]
forall a. C a => a -> [ShowS]
text a
a [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ b -> [ShowS]
forall a. C a => a -> [ShowS]
text b
b [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ c -> [ShowS]
forall a. C a => a -> [ShowS]
text c
c [ShowS] -> [ShowS] -> [ShowS]
forall a. [a] -> [a] -> [a]
++ d -> [ShowS]
forall a. C a => a -> [ShowS]
text d
d
   columnCount :: ColumnCount (a, b, c, d)
columnCount =
      (a -> b -> c -> d -> (a, b, c, d))
-> ColumnCount (a -> b -> c -> d -> (a, b, c, d))
forall a. a -> ColumnCount a
pure (,,,)
         ColumnCount (a -> b -> c -> d -> (a, b, c, d))
-> ColumnCount a -> ColumnCount (b -> c -> d -> (a, b, c, d))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount a
forall a. C a => ColumnCount a
columnCount
         ColumnCount (b -> c -> d -> (a, b, c, d))
-> ColumnCount b -> ColumnCount (c -> d -> (a, b, c, d))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount b
forall a. C a => ColumnCount a
columnCount
         ColumnCount (c -> d -> (a, b, c, d))
-> ColumnCount c -> ColumnCount (d -> (a, b, c, d))
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount c
forall a. C a => ColumnCount a
columnCount
         ColumnCount (d -> (a, b, c, d))
-> ColumnCount d -> ColumnCount (a, b, c, d)
forall a b. ColumnCount (a -> b) -> ColumnCount a -> ColumnCount b
<*> ColumnCount d
forall a. C a => ColumnCount a
columnCount