-----------------------------------------------------------------------------
--
-- Module      :  Data.Relational.Value
-- Copyright   :  (c) 2015-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | 'Data.Aeson.Types.Value' from <https://hackage.haskell.org/package/aeson aeson> for use in tuples and relations.
--
-----------------------------------------------------------------------------


{-# LANGUAGE TypeFamilies              #-}

{-# OPTIONS_GHC -fno-warn-deprecations #-}


module Data.Relational.Value {-# DEPRECATED "This module will be replaced in a future release." #-} (
-- Types
  Value(..)
-- Functions
, asValue
, valueAsRealFloat
, asRealFloat
, valueAsString
, string
, number
, number'
, enum
, valueAsEnum
, readTable
, writeTable
) where


import Control.Applicative ((<|>))
import Data.Aeson.Types (ToJSON(..), Value(..))
import Data.Default.Util (nan)
import Data.Maybe (fromMaybe)
import Data.Maybe.Util (maybeRead)
import Data.Relational (Tuple(..))
import Data.Relational.Lists (Table(..), Tabulation)
import Data.Scientific (fromFloatDigits)
import Data.Text (pack, unpack)

import qualified Data.Relational.Lists as Lists (readTable, writeTable)


-- | Read a value.
asValue :: String -- ^ The string.
        -> Value  -- ^ The value.
asValue s =
  let
    n = if null s then Just Null else Nothing
    b = toJSON <$> (maybeRead s :: Maybe Bool)
    x = toJSON <$> (maybeRead s :: Maybe Double) 
  in
    fromMaybe (toJSON s) $ n <|> b <|> x


-- | Convert a numeric value.
valueAsRealFloat :: RealFloat a => Value -> a
valueAsRealFloat (Number x) = realToFrac x
valueAsRealFloat _          = nan


-- | Read a numeric value.
asRealFloat :: (RealFloat a, Read a) => String -> a
asRealFloat = fromMaybe nan . maybeRead


-- | Convert to a string value.
valueAsString :: Value -> String
valueAsString Null       = ""
valueAsString (Bool b  ) = show b
valueAsString (Number x) = show x
valueAsString (String s) = unpack s
valueAsString x          = show x


-- | Convert a string to a value.
string :: String -> Value
string = String . pack


-- | Convert a number to a value.
number :: RealFloat a => a -> Value
number = Number . fromFloatDigits


-- | Convert a number to a value.
number' :: String -> Value
number' = number . (read :: String -> Double)


-- | Convert an enumeration to a value.
enum :: (Enum a, Show a) => a -> Value
enum = string . show


-- | Convert a value to an enumeration.
valueAsEnum :: (Enum a, Read a) => Value -> a
valueAsEnum = read . valueAsString


-- | Read a table.
readTable :: (Attribute r ~ Value, Tuple r)
          => FilePath                       -- ^ The file path.
          -> IO (Table r)                   -- ^ Action to read the table.
readTable path =
  fmap (makeTuple . fmap asValue . attributes) 
    <$> (Lists.readTable path :: IO (Tabulation String))


-- | Write a table.
writeTable :: (Attribute r ~ Value, Tuple r)
           => FilePath                       -- ^ The file path.
           -> Table r                        -- ^ The table.
           -> IO ()                          -- ^ Action to write the table.
writeTable path x =
  Lists.writeTable path
    (fmap (makeTuple . fmap valueAsString . attributes) x :: Tabulation String)