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
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
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
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
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"