llsd-0.1.0.1: Network/Format/LLSD/Conversion.hs
{-# LANGUAGE TypeSynonymInstances #-}
-- |
-- Module : Network.Format.LLSD.Conversions
-- Copyright : (c) Linden Lab 2009, 2010
-- License : MIT
-- Maintainer : bos@lindenlab.com
-- Stability : provisional
-- Portability : portable
--
-- Conversion operations for the simple types
--
-- This module implements the conversion rules for LLSD. The conversion rules
-- define how a received LLSD value of type a should be converted to be used
-- as a value of type b. These conversions are designed to ensure fidelity of
-- intended values as LLSD moves through systems and languages that may have
-- less rich type systems, and/or "common" automatic value conversion rules.
--
-- Conversion in LLSD is always defined to return a value. However, for use
-- by LLIDL, knowledge of the fidelity of the conversion is needed
module Network.Format.LLSD.Conversion (
Fidelity(..), (~&~), (~|~),
Conversion,
ConvertTo,
ConvertFrom(..),
convert,
)
where
import Data.Maybe (fromJust, listToMaybe)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import System.Locale (defaultTimeLocale)
import qualified Data.ByteString.Lazy as Byte
import qualified Data.Time as Time
import qualified Data.UUID as UUID
import qualified Network.URI as URI
-- | How accurately a conversion was performed
data Fidelity = Incompatible -- the value was a type that couldn't convert
| Unconvertable -- convertable type, but conversion failed
| Approximate -- converted, but information was lost
| Mixed -- value has both additional and defaulted data
| Additional -- value had additional data (for maps and arrays)
| Defaulted -- the default value due to undef or ""
| Converted -- the value was converted
| Native -- value was natively the correct type
| Matched -- the value has the correct shape
deriving (Eq, Ord, Show)
{- Notes:
Mixed, Additional, and Matched are used by LLIDL for maps and arrays. No
conversions return these values.
This whole scheme is somewhat overblown. There are really only three
levels of Fidelity LLIDL cares about:
Fidelity Match Valid Invalid
Incompatible - - x
Unconvertable - - x
Approximate - - x
Defaulted - x -
Converted x x -
Native x x -
Integrity Match Valid Invalid
Incompatible - - x
Mixed - x -
Additional - x -
Defaulted - x -
Matched x x -
-}
(~&~) :: Fidelity -> Fidelity -> Fidelity
Incompatible ~&~ _ = Incompatible -- important short circuit case
Defaulted ~&~ Additional = Mixed
Additional ~&~ Defaulted = Mixed
a ~&~ b = min a b
infixr 3 ~&~
(~|~) :: Fidelity -> Fidelity -> Fidelity
Matched ~|~ _ = Matched -- important short circuit case
a ~|~ b = max a b
infixr 2 ~|~
-- | The result of a conversion
type Conversion a = (a, Fidelity)
class ConvertTo a where
defaultValue :: a
convertFromUndef :: () -> Conversion a
convertFromBool :: Bool -> Conversion a
convertFromInt :: Int -> Conversion a
convertFromReal :: Double -> Conversion a
convertFromString :: String -> Conversion a
convertFromUUID :: UUID.UUID -> Conversion a
convertFromDate :: Time.UTCTime -> Conversion a
convertFromURI :: URI.URI -> Conversion a
convertFromBinary :: Byte.ByteString -> Conversion a
-- default implementations
convertFromUndef = const $ defaultWith Defaulted
convertFromBool = const $ defaultWith Incompatible
convertFromInt = const $ defaultWith Incompatible
convertFromReal = const $ defaultWith Incompatible
convertFromString = const $ defaultWith Incompatible
convertFromUUID = const $ defaultWith Incompatible
convertFromDate = const $ defaultWith Incompatible
convertFromURI = const $ defaultWith Incompatible
convertFromBinary = const $ defaultWith Incompatible
native :: a -> Conversion a
native a = (a, Native)
convertAsJust :: a -> Conversion a
convertAsJust a = (a, Converted)
defaultWith :: (ConvertTo a) => Fidelity -> Conversion a
defaultWith f = (defaultValue, f)
convertString :: (ConvertTo a) =>
(String -> Maybe a) -> String -> Conversion a
convertString f s =
if null s
then defaultWith Defaulted
else maybe (defaultWith Unconvertable) convertAsJust $ f s
instance ConvertTo Bool where
defaultValue = False
convertFromBool = native
convertFromInt = boolConv 0 1 (/= 0)
convertFromReal = boolConv 0.0 1.0 (\v -> v < 0.0 || 0.0 < v)
-- written this way to handle NaNs
convertFromString = boolConv "" "true" (/= "")
boolConv :: (Eq a) => a -> a -> (a -> Bool) -> a -> Conversion Bool
boolConv vFalse vTrue f v = (f v, if canonical then Converted else Approximate)
where canonical = v == vFalse || v == vTrue
instance ConvertTo Int where
defaultValue = 0
convertFromBool v = convertAsJust $ if v then 1 else 0
convertFromInt = native
convertFromReal = intFromDouble
convertFromString = intFromDoubleConv . convertFromString
intFromDouble :: Double -> Conversion Int
intFromDouble d = (i, f)
where i = round d
f = if fromIntegral i == d then Converted else Approximate
intFromDoubleConv :: Conversion Double -> Conversion Int
intFromDoubleConv (d, Converted) = intFromDouble d
intFromDoubleConv (_, f) = (defaultValue, f)
instance ConvertTo Double where
defaultValue = 0.0
convertFromBool v = convertAsJust $ if v then 1.0 else 0.0
convertFromInt = convertAsJust . realToFrac
convertFromReal = native
convertFromString = convertString readDouble
instance ConvertTo String where
defaultValue = ""
convertFromBool v = convertAsJust $ if v then "true" else ""
convertFromInt = convertAsJust . show
convertFromReal = convertAsJust . show
convertFromString = native
convertFromUUID = convertAsJust . UUID.toString
convertFromDate =
convertAsJust . Time.formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ"
convertFromURI v = convertAsJust $ URI.uriToString id v ""
instance ConvertTo UUID.UUID where
defaultValue =
fromJust $ UUID.fromString "00000000-0000-0000-0000-000000000000"
-- FIXME: replace when UUID exports the nilUUID
convertFromString = convertString UUID.fromString
convertFromUUID = native
instance ConvertTo Time.UTCTime where
defaultValue = posixSecondsToUTCTime 0
convertFromString =
convertString $ Time.parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ"
convertFromDate = native
instance ConvertTo URI.URI where
defaultValue = URI.nullURI
convertFromString = convertString URI.parseURIReference
convertFromURI = native
instance ConvertTo Byte.ByteString where
defaultValue = Byte.empty
convertFromBinary = native
class ConvertFrom a where
conversion :: (ConvertTo b) => a -> Conversion b
instance ConvertFrom () where conversion = convertFromUndef
instance ConvertFrom Bool where conversion = convertFromBool
instance ConvertFrom Int where conversion = convertFromInt
instance ConvertFrom Double where conversion = convertFromReal
instance ConvertFrom String where conversion = convertFromString
instance ConvertFrom UUID.UUID where conversion = convertFromUUID
instance ConvertFrom Time.UTCTime where conversion = convertFromDate
instance ConvertFrom URI.URI where conversion = convertFromURI
instance ConvertFrom Byte.ByteString where conversion = convertFromBinary
convert :: (ConvertFrom a, ConvertTo b) => a -> b
convert = fst . conversion
readDouble :: String -> Maybe Double
readDouble = listToMaybe . map fst . filter ((=="") . snd) . reads