-----------------------------------------------------------------------------
-- |
-- Module      :  Database.TxtSushi.EvaluatedExpression
-- Copyright   :  (c) Keith Sheppard 2009-2010
-- License     :  BSD3
-- Maintainer  :  keithshep@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- EvaluatedExpression data type along with supporting functions
--
-----------------------------------------------------------------------------

module Database.TxtSushi.EvaluatedExpression (
    EvaluatedExpression(..),
    realCompare,
    intCompare,
    boolCompare,
    stringCompare,
    coerceString,
    maybeCoerceInt,
    coerceInt,
    maybeCoerceReal,
    coerceReal,
    maybeReadBool,
    maybeCoerceBool,
    coerceBool) where

import Data.Char
import Data.Ord

import Database.TxtSushi.ParseUtil

data EvaluatedExpression =
    StringExpression    String |
    RealExpression      Double |
    IntExpression       Int |
    BoolExpression      Bool deriving Show

-- order evaluated expressions using our type coercion rules where possible
instance Ord EvaluatedExpression where
    compare expr1@(RealExpression _) expr2 = expr1 `realCompare` expr2
    compare expr1 expr2@(RealExpression _) = expr1 `realCompare` expr2
    
    compare expr1@(IntExpression _) expr2 = expr1 `intCompare` expr2
    compare expr1 expr2@(IntExpression _) = expr1 `intCompare` expr2
    
    compare expr1@(BoolExpression _) expr2 = expr1 `boolCompare` expr2
    compare expr1 expr2@(BoolExpression _) = expr1 `boolCompare` expr2
    
    compare expr1 expr2 = expr1 `stringCompare` expr2

realCompare :: EvaluatedExpression -> EvaluatedExpression -> Ordering
realCompare expr1 expr2 =
    maybeCoerceReal expr1 `myCompare` maybeCoerceReal expr2
    where
        myCompare (Just r1) (Just r2) = r1 `compare` r2
        myCompare _ _ = expr1 `stringCompare` expr2

intCompare :: EvaluatedExpression -> EvaluatedExpression -> Ordering
intCompare expr1 expr2 =
    maybeCoerceInt expr1 `myCompare` maybeCoerceInt expr2
    where
        myCompare (Just i1) (Just i2) = i1 `compare` i2
        myCompare _ _ = expr1 `realCompare` expr2

boolCompare :: EvaluatedExpression -> EvaluatedExpression -> Ordering
boolCompare expr1 expr2 =
    maybeCoerceBool expr1 `myCompare` maybeCoerceBool expr2
    where
        myCompare (Just b1) (Just b2) = b1 `compare` b2
        myCompare _ _ = expr1 `stringCompare` expr2

stringCompare :: EvaluatedExpression -> EvaluatedExpression -> Ordering
stringCompare = comparing coerceString

-- base equality off of the Ord definition. pretty simple huh?
instance Eq EvaluatedExpression where
    expr1 == expr2 = expr1 `compare` expr2 == EQ

coerceString :: EvaluatedExpression -> String
coerceString (StringExpression string)  = string
coerceString (RealExpression real)      = show real
coerceString (IntExpression int)        = show int
coerceString (BoolExpression bool)      = if bool then "true" else "false"

maybeCoerceInt :: EvaluatedExpression -> Maybe Int
maybeCoerceInt (StringExpression string) = maybeReadInt string
maybeCoerceInt (RealExpression real)     = Just $ floor real -- TOOD: floor OK for negatives too?
maybeCoerceInt (IntExpression int)       = Just int
maybeCoerceInt (BoolExpression _)        = Nothing

coerceInt :: EvaluatedExpression -> Int
coerceInt evalExpr = case maybeCoerceInt evalExpr of
    Just int -> int
    Nothing ->
        error $ "could not convert \"" ++ coerceString evalExpr ++
                "\" to an integer value"

maybeCoerceReal :: EvaluatedExpression -> Maybe Double
maybeCoerceReal (StringExpression string) = maybeReadReal string
maybeCoerceReal (RealExpression real)     = Just real
maybeCoerceReal (IntExpression int)       = Just $ fromIntegral int
maybeCoerceReal (BoolExpression _)        = Nothing

coerceReal :: EvaluatedExpression -> Double
coerceReal evalExpr = case maybeCoerceReal evalExpr of
    Just real -> real
    Nothing ->
        error $ "could not convert \"" ++ coerceString evalExpr ++
                "\" to a numeric value"

maybeReadBool :: String -> Maybe Bool
maybeReadBool boolStr = case map toLower $ trimSpace boolStr of
    "true"      -> Just True
    "false"     -> Just False
    _           -> Nothing
    where
        -- trims leading and trailing spaces
        trimSpace :: String -> String
        trimSpace = f . f
            where f = reverse . dropWhile isSpace

maybeCoerceBool :: EvaluatedExpression -> Maybe Bool
maybeCoerceBool (StringExpression string) = maybeReadBool string
maybeCoerceBool (RealExpression _)        = Nothing
maybeCoerceBool (IntExpression _)         = Nothing
maybeCoerceBool (BoolExpression bool)     = Just bool

coerceBool :: EvaluatedExpression -> Bool
coerceBool evalExpr = case maybeCoerceBool evalExpr of
    Just bool -> bool
    Nothing ->
        error $ "could not convert \"" ++ coerceString evalExpr ++
                "\" to a boolean value"