hs-php-session 0.0.9.2 → 0.0.9.3

raw patch · 5 files changed

+942/−2 lines, 5 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Data/PHPSession.hs +31/−1
• Data/PHPSession/Conv.hs +265/−0
• Data/PHPSession/ImplicitConv/ConvBool.hs +284/−0
• Data/PHPSession/ImplicitConv/PHPTypeCoercion.hs +358/−0
• hs-php-session.cabal +4/−1

@@ -8,8 +8,31 @@ -- Portability: portable -- -- Encodes and decodes serialized PHP sessions in the format used by the \"php\" setting--- for session.serialize_handler.+-- for session.serialize_handler, as well as encodes and decodes PHP values in general+-- in the format used by PHP's serialize/unserialize.+--+-- An example of using 'decodePHPSessionValue' and 'convFrom' to decode and convert values+-- from the serialized contents of a 'LBS.ByteString' to @[('Int','LBS.ByteString')]@:+--+-- > import qualified Data.PHPSession as PHPSess+-- >+-- > getArrayValues :: LBS.ByteString -> [(Int, LBS.ByteString)]+-- > getArrayValues encoded =+-- >   case PHPSess.decodePHPSessionValue encoded of+-- >     Nothing -> [] :: [(Int,LBS.ByteString)]+-- >     Just b -> PHPSess.convFrom b -- +-- Starting from a value output from the following PHP code:+--+-- @/<?php/ /echo/ /serialize/(/array/(0 =\> \'Hello\', 5 => \'World\'));@+-- @\/\* Outputs: \"a:2:{i:0;s:5:\\\"Hello\\\";i:5;s:5:\\\"World\\\";}\" \*\/@+--+-- The following can be computed:+--+-- >>> getArrayValues $ LBS.pack "a:2:{i:0;s:5:\"Hello\";i:5;s:5:\"World\";}"+-- [(0,"Hello"),(5,"World")]+--+--   module Data.PHPSession (     -- * Decode from 'ByteString'@@ -20,6 +43,11 @@     -- * Encode to 'ByteString'     encodePHPSession,     encodePHPSessionValue,+    -- * Convert to 'PHPSessionValue'+    convTo,+    -- * Convert from 'PHPSessionValue'+    convFrom,+    convFromSafe,     -- * Decode only part of a 'ByteString'     decodePartialPHPSessionValue,     decodePartialPHPSessionValueEither,@@ -31,11 +59,13 @@ ) where  import Data.PHPSession.Types+import Data.PHPSession.Conv (convTo, convFrom, convFromSafe)  import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.List as L import qualified Data.Char as C+import Data.List (foldl') import Data.List (foldl')  

@@ -0,0 +1,265 @@+{-# LANGUAGE FlexibleInstances #-}+-- |+-- Module : Data.PHPSession.Conv+-- Copyright: (c) 2014 Edward Blake+-- License: BSD-style+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Non-coerced translation between 'PHPSessionValue' and various Haskell types.+-- 'convTo' provide convenient translation from native types to 'PHPSessionValue',+-- while translation from 'PHPSessionValue' to native types is provided through+-- 'convFrom' and 'convFromSafe'.+-- +module Data.PHPSession.Conv (+    -- * Convert to 'PHPSessionValue'+    convTo,+    -- * Convert from 'PHPSessionValue'+    convFrom,+    convFromSafe,+    -- * Type classes+    ConversionToPHPValue(..),+    ConversionFromPHPValueOrMismatch(..)+) where++import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS+import Data.PHPSession.Types+import Data.Int (Int32, Int64)+import Data.List as L (foldl')++-- | 'convTo' is a convenience function that converts natively typed+-- values to 'PHPSessionValue', with the resulting PHP type determined+-- by the type cast or inferred.+--+-- > arrayOfPHPStrings :: PHPSessionValue+-- > arrayOfPHPStrings =+-- >   let str1 = "Hello" :: BS.ByteString+-- >       str2 = "World"+-- >    in convTo [(0 :: Int, str1), (1, str2)]+--+-- In the above example code, the @OverloadedStrings@ language extension is assumed.+--+convTo :: ConversionToPHPValue a => a -> PHPSessionValue+convTo val = convTo' val++class ConversionToPHPValue a where+  convTo' :: a -> PHPSessionValue++class ConversionFromPHPValueOrMismatch b where+  convFromOM :: PHPSessionValue -> Either String b++instance ConversionToPHPValue PHPSessionValue where+  convTo' var = var++instance ConversionToPHPValue [(PHPSessionValue,PHPSessionValue)] where+  convTo' var = PHPSessionValueArray var++instance (ConversionToPHPValue a, ConversionToPHPValue b) => ConversionToPHPValue [(a,b)] where+  convTo' var = PHPSessionValueArray $ map (\(al,ar) -> (convTo' al, convTo' ar)) var++instance ConversionToPHPValue Bool where+  convTo' var = PHPSessionValueBool var++instance ConversionToPHPValue Double where+  convTo' var = PHPSessionValueFloat (Right var)++instance ConversionToPHPValue Int where+  convTo' var = PHPSessionValueInt var++instance ConversionToPHPValue Int32 where+  convTo' var = PHPSessionValueInt (fromIntegral var)++instance ConversionToPHPValue Int64 where+  convTo' var = PHPSessionValueInt (fromIntegral var)++instance ConversionToPHPValue a => ConversionToPHPValue (Maybe a) where+  convTo' Nothing = PHPSessionValueNull+  convTo' (Just var) = convTo' var++instance ConversionToPHPValue (PHPSessionClassName, [(PHPSessionValue,PHPSessionValue)]) where+  convTo' (cls,arr) = PHPSessionValueObject cls arr++instance ConversionToPHPValue (PHPSessionClassName, LBS.ByteString) where+  convTo' (cls,arr) = PHPSessionValueObjectSerializeable cls arr++instance ConversionToPHPValue LBS.ByteString where+  convTo' var = PHPSessionValueString var++instance ConversionToPHPValue BS.ByteString where+  convTo' var = PHPSessionValueString (LBS.fromChunks [var])++instance ConversionFromPHPValueOrMismatch [(PHPSessionValue,PHPSessionValue)] where+  convFromOM (PHPSessionValueArray var) = Right var+  convFromOM v = mismatchError v "[(PHPSessionValue,PHPSessionValue)]"++instance ConversionFromPHPValueOrMismatch a => ConversionFromPHPValueOrMismatch [(a,PHPSessionValue)] where+  convFromOM (PHPSessionValueArray vars) =+    case L.foldl' ontoTuple (Right []) vars of+      Left str -> Left str+      Right lst -> Right $ reverse lst+    where+      ontoTuple (Left str) _ = Left str+      ontoTuple (Right lst) (l,r) = +        let l' = convFromOM l+         in case l' of+              Left errl -> Left errl+              Right l'' ->+                Right ((l'',r) : lst)+  convFromOM v = mismatchError v "ConversionFromPHPValueOrMismatch a => ConversionFromPHPValueOrMismatch [(a,PHPSessionValue)]"++instance ConversionFromPHPValueOrMismatch b => ConversionFromPHPValueOrMismatch [(PHPSessionValue,b)] where+  convFromOM (PHPSessionValueArray vars) =+    convArrayRightSide vars convFromOM+  convFromOM v = mismatchError v "ConversionFromPHPValueOrMismatch b => ConversionFromPHPValueOrMismatch [(PHPSessionValue,b)]"++convArrayRightSide vars conv =+  case L.foldl' ontoTuple (Right []) vars of+    Left str -> Left str+    Right lst -> Right $ reverse lst+  where+    ontoTuple (Left str) _ = Left str+    ontoTuple (Right lst) (l,r) = +      case conv r of+        Left errr -> Left errr+        Right r'' ->+          Right $ (l, r'') : lst++instance (ConversionFromPHPValueOrMismatch a, ConversionFromPHPValueOrMismatch b) => ConversionFromPHPValueOrMismatch [(a,b)] where+  convFromOM (PHPSessionValueArray vars) =+    convArrayBothSides vars convFromOM+  convFromOM v = mismatchError v "(ConversionFromPHPValueOrMismatch a, ConversionFromPHPValueOrMismatch b) => ConversionFromPHPValueOrMismatch [(a,b)]"++convArrayBothSides vars conv =+  case L.foldl' ontoTuple (Right []) vars of+    Left str -> Left str+    Right lst -> Right $ reverse lst+  where+    ontoTuple (Left str) _ = Left str+    ontoTuple (Right lst) (l,r) = +      let l' = convFromOM l+          r' = conv r+       in case l' of+            Left errl -> Left errl+            Right l'' ->+              case r' of+                Left errr -> Left errr+                Right r'' ->+                  Right ((l'', r'') : lst)+++instance ConversionFromPHPValueOrMismatch Bool where+  convFromOM (PHPSessionValueBool var) = Right var+  convFromOM v = mismatchError v "Bool"++instance ConversionFromPHPValueOrMismatch Double where+  convFromOM (PHPSessionValueFloat (Left  var)) = Right $ fromIntegral var+  convFromOM (PHPSessionValueFloat (Right var)) = Right var+  convFromOM v = mismatchError v "Double"++instance ConversionFromPHPValueOrMismatch Int where+  convFromOM (PHPSessionValueInt var) = Right var+  convFromOM v = mismatchError v "Int"++instance ConversionFromPHPValueOrMismatch Int32 where+  convFromOM (PHPSessionValueInt var) = Right $ fromIntegral var+  convFromOM v = mismatchError v "Int32"++instance ConversionFromPHPValueOrMismatch Int64 where+  convFromOM (PHPSessionValueInt var) = Right $ fromIntegral var+  convFromOM v = mismatchError v "Int64"++instance Integral n => ConversionFromPHPValueOrMismatch (Either n Double) where+  convFromOM (PHPSessionValueFloat (Right var)) = (Right . Right) var+  convFromOM (PHPSessionValueFloat (Left  var)) = (Right . Right . fromIntegral) var+  convFromOM (PHPSessionValueInt var)           = (Right . Left  . fromIntegral) var+  convFromOM v = mismatchError v "Integral n => Either n Double"++instance Integral n => ConversionFromPHPValueOrMismatch (Either n LBS.ByteString) where+  convFromOM (PHPSessionValueString var) = (Right . Right) var+  convFromOM (PHPSessionValueInt var)    = (Right . Left . fromIntegral) var+  convFromOM v = mismatchError v "Integral n => Either n ByteString"++instance ConversionFromPHPValueOrMismatch (Either Double LBS.ByteString) where+  convFromOM (PHPSessionValueString var)        = (Right . Right) var+  convFromOM (PHPSessionValueFloat (Right var)) = (Right . Left ) var+  convFromOM (PHPSessionValueFloat (Left  var)) = (Right . Left . fromIntegral) var+  convFromOM v = mismatchError v "Either Double ByteString"++instance Integral n => ConversionFromPHPValueOrMismatch (Either n BS.ByteString) where+  convFromOM (PHPSessionValueString var) = (Right . Right . BS.concat . LBS.toChunks) var+  convFromOM (PHPSessionValueInt var)    = (Right . Left . fromIntegral) var+  convFromOM v = mismatchError v "Integral n => Either n ByteString"++instance ConversionFromPHPValueOrMismatch (Either Double BS.ByteString) where+  convFromOM (PHPSessionValueString var)        = (Right . Right . BS.concat . LBS.toChunks) var+  convFromOM (PHPSessionValueFloat (Right var)) = (Right . Left ) var+  convFromOM (PHPSessionValueFloat (Left  var)) = (Right . Left . fromIntegral) var+  convFromOM v = mismatchError v "Either Double ByteString"++instance ConversionFromPHPValueOrMismatch (PHPSessionClassName, [(PHPSessionValue,PHPSessionValue)]) where+  convFromOM (PHPSessionValueObject cls arr) = Right (cls,arr)+  convFromOM v = mismatchError v "(PHPSessionClassName, [(PHPSessionValue,PHPSessionValue)])"++instance ConversionFromPHPValueOrMismatch (PHPSessionClassName, LBS.ByteString) where+  convFromOM (PHPSessionValueObjectSerializeable cls arr) = Right (cls,arr)+  convFromOM v = mismatchError v "(PHPSessionClassName, ByteString)"++instance ConversionFromPHPValueOrMismatch LBS.ByteString where+  convFromOM (PHPSessionValueString var) = Right var+  convFromOM v = mismatchError v "ByteString"++instance ConversionFromPHPValueOrMismatch BS.ByteString where+  convFromOM (PHPSessionValueString var) = (Right . BS.concat . LBS.toChunks) var+  convFromOM v = mismatchError v "ByteString"++instance ConversionFromPHPValueOrMismatch a => ConversionFromPHPValueOrMismatch (Maybe a) where+  convFromOM PHPSessionValueNull = Right Nothing+  convFromOM v =+    case convFromOM v of+      Left s -> Left s+      Right b' -> Right (Just b')+++mismatchError v totype =+  Left $ "Type mismatch converting from (" ++ show v ++ ") to " ++ totype++-- | 'convFrom' and 'convFromSafe' are convenience functions that translate PHP+-- values stored as 'PHPSessionValue' into appropriate Haskell types depending on+-- the desired type cast or inferred. Functions provided in this module provide+-- non-coerced type translations and so will either carry on the translation or+-- signal the fact that the attempted conversion will alter the type of the+-- value. For situations where altering value types is expected, alternative+-- conversion functions with similar type signatures are provided in modules+-- within /Data.PHPSession.ImplicitConv/.+--+-- The example arrayOfPHPStrings definition given in 'convTo' can be reverted back+-- to Haskell types, which evaluates to @[(0,\"Hello\"),(1,\"World\")]@.+-- +-- >>> convFrom arrayOfPHPStrings :: [(Int,LBS.ByteString)]+-- [(0,"Hello"),(1,"World")]+--+-- However, if the desired type signature is changed to a completely different type,+-- then a runtime exception is thrown:+--+-- >>> convFrom arrayOfPHPStrings :: [(Int,Int)]+-- *** Exception: Type mismatch converting from (PHPSessionValueString "Hello") to Int+--+-- Where there is the possibility that the value being sought may be @/NULL/@, the+-- type should be @('Maybe' a)@.+--+convFrom :: ConversionFromPHPValueOrMismatch b => PHPSessionValue -> b+convFrom var =+    case convFromOM var of+      Left message -> error message+      Right var' -> var'++-- | A version of 'convFrom' which returns a 'Left' with an error message instead +-- of throwing an exception.+--+convFromSafe+  :: ConversionFromPHPValueOrMismatch b =>+     PHPSessionValue -> Either String b+convFromSafe var = convFromOM var+

@@ -0,0 +1,284 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Data.PHPSession.ImplicitConv.ConvBool+-- Copyright: (c) 2014 Edward Blake+-- License: BSD-style+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Non-coerced and coerced rule sets for converting 'PHPSessionValue' objects to 'Bool'.+-- +module Data.PHPSession.ImplicitConv.ConvBool (+    -- * Non-coerced from 'PHPSessionValue'+    boolDefaultFalseFrom,+    boolDefaultTrueFrom,+    -- * Type coercion from 'PHPSessionValue'+    boolFromPHPLooseComparisonWithTrue,+    boolFromPHPLooseComparisonWithTrueNullable,+    boolFromReducedLooseCoercionSafe,+    boolFromReducedLooseCoercion,+    boolFromReducedLooseCoercionNullableSafe,+    boolFromReducedLooseCoercionNullable,+    boolFromESBooleanCoercionRules,+    boolFromPerlBooleanCoercionRules,+    boolFromPythonBooleanCoercionRules,+    boolFromLuaBooleanCoercionRules+) where++import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS+import Data.PHPSession.Types++-- | Returns the value of a boolean value as a 'Bool', or returns False as the default+-- 'Bool' value if the 'PHPSessionValue' is not a boolean type. This function is+-- similar to the \"strict comparison\" operator against the boolean @/TRUE/@ value.+--+boolDefaultFalseFrom :: PHPSessionValue -> Bool+boolDefaultFalseFrom var =+  case var of+    PHPSessionValueBool b -> b+    _ -> False++-- | Returns the value of a boolean value as a 'Bool', or returns True as the default+-- 'Bool' value if the 'PHPSessionValue' is not a boolean type.+-- +boolDefaultTrueFrom :: PHPSessionValue -> Bool+boolDefaultTrueFrom var =+  case var of+    PHPSessionValueBool b -> b+    _ -> True++-- | Coerces a 'PHPSessionValue' to a 'Bool' based on PHP's conversion rules to+-- convert arbitrary values to boolean for evaluation. This function's behaviour+-- is also reminiscent of PHP's \"loose comparison\" operator against boolean+-- @/TRUE/@.+-- <http://php.net/manual/language.types.boolean.php>+-- +-- Values that result in 'True' are @/TRUE/@, non-zero numbers, non-empty strings+-- other than \"0\", objects, and non-empty arrays.+-- +-- A conversion documented in the PHP manual involving @SimpleXML@ objects that+-- coerce to @/FALSE/@ instead of @/TRUE/@ when created with empty tags is not+-- implemented by this function, as SimpleXML objects cannot be serialized directly+-- and so don't have a valid serializable form to convert from in any case.+--+-- Because of the range of valid values of the \"loose comparison\" operator, this+-- function and variations based on other dynamically typed languages is provided +-- mainly for circumstances where they may be the best fit to map particular data+-- values to a boolean truth value system. 'boolFromReducedLooseCoercionSafe'+-- provides a significantly reduced subset of valid values to coerce from for the+-- purpose of determining a \"confirmation\" value, as opposed to simply determining+-- if a value exists or not.+--+boolFromPHPLooseComparisonWithTrue :: PHPSessionValue -> Bool+boolFromPHPLooseComparisonWithTrue var =+  case var of+    PHPSessionValueBool b -> b+    PHPSessionValueArray arr ->+      case arr of+        [] -> False+        _  -> True+    PHPSessionValueFloat (Left i) -> (i /= 0)+    PHPSessionValueFloat (Right f) -> (f /= 0.0)+    PHPSessionValueInt i -> (i /= 0)+    PHPSessionValueNull -> False+    PHPSessionValueString str ->+      case str of+        ""  -> False+        "0" -> False+        _   -> True+    PHPSessionValueObject _ _ -> True+    PHPSessionValueObjectSerializeable _ _ -> True+    PHPSessionValueMisc _ _ -> True++-- | A version of 'boolFromPHPLooseComparisonWithTrue' where @/NULL/@ returns 'Nothing'+-- and all other inputs returns 'Just' with the boolean result.+boolFromPHPLooseComparisonWithTrueNullable :: PHPSessionValue -> Maybe Bool+boolFromPHPLooseComparisonWithTrueNullable var =+  case var of+    PHPSessionValueNull -> Nothing+    _ | var /= PHPSessionValueNull ->+      Just $ boolFromPHPLooseComparisonWithTrue var+++-- | Coerces a 'PHPSessionValue' to a 'Bool' through a reduced subset of valid values.+-- 'boolFromReducedLooseCoercionSafe' and 'boolFromReducedLooseCoercion' are+-- functions intended for testing a variable for a boolean \"confirmation\" from a+-- limited number of probable representations.+--+-- Values that result in 'True' are @/TRUE/@, non-zero numbers, \"1\" and \"-1\".+--+-- Values that result in 'False' are @/FALSE/@, zero numbers, @/NULL/@, \"0\" and \"\".+--+-- Values such as arrays, objects and arbitrary strings, are invalid with this+-- function and return an error. In the case of 'boolFromReducedLooseCoercionSafe'+-- this returns a 'Left' with the error message.+--+boolFromReducedLooseCoercionSafe :: PHPSessionValue -> Either String Bool+boolFromReducedLooseCoercionSafe var =+  case var of+    PHPSessionValueArray _ -> mismatchError var "Bool"+    PHPSessionValueBool b -> Right b+    PHPSessionValueFloat (Left i) -> Right (i /= 0)+    PHPSessionValueFloat (Right f) -> Right (f /= 0)+    PHPSessionValueInt i -> Right (i /= 0)+    PHPSessionValueNull -> Right False+    PHPSessionValueObject _ _ -> mismatchError var "Bool"+    PHPSessionValueObjectSerializeable _ _ -> mismatchError var "Bool"+    PHPSessionValueString str ->+      case str of+        "1"  -> Right True+        "-1" -> Right True+        "0"  -> Right False+        ""   -> Right False+        _    -> mismatchError var "Bool"+    PHPSessionValueMisc _ _ -> mismatchError var "Bool"++mismatchError v totype =+  Left $ "Type mismatch converting from (" ++ show v ++ ") to " ++ totype+++-- | A version of 'boolFromReducedLooseCoercionSafe' that may throw exceptions.+--+boolFromReducedLooseCoercion :: PHPSessionValue -> Bool+boolFromReducedLooseCoercion var =+    case boolFromReducedLooseCoercionSafe var of+      Left message -> error message+      Right var' -> var'++-- | A version of 'boolFromReducedLooseCoercionSafe' where @/NULL/@ returns 'Right' 'Nothing'+-- and all other inputs returns 'Right' 'Just' with the boolean result. May return 'Left'+-- with an error message if given invalid values.+--+boolFromReducedLooseCoercionNullableSafe :: PHPSessionValue -> Either String (Maybe Bool)+boolFromReducedLooseCoercionNullableSafe var =+  case var of+    PHPSessionValueNull -> Right Nothing+    _ | var /= PHPSessionValueNull ->+      case boolFromReducedLooseCoercionSafe var of+        Left message -> Left message+        Right result -> Right (Just result)++-- | A version of 'boolFromReducedLooseCoercion' where @/NULL/@ returns 'Nothing'+-- and all other inputs returns 'Just' with the boolean result. May throw an+-- exception on invalid values.+--+boolFromReducedLooseCoercionNullable :: PHPSessionValue -> Maybe Bool+boolFromReducedLooseCoercionNullable var =+  case var of+    PHPSessionValueNull -> Nothing+    _ | var /= PHPSessionValueNull ->+      Just $ boolFromReducedLooseCoercion var+++-- | Alternative boolean coercion based on the JS/ES boolean conversion rules. +-- A particular distinction of the coercion behaviour of this function compared+-- to the behaviour of other functions is that floating point NaN returns+-- 'False' instead of 'True'. Values that return 'False' are @/NAN/@, 0,+-- the empty string \"\", @/NULL/@ and @/FALSE/@+--+-- PHP objects, arrays and objects implementing Serializable always return 'True'.+--+-- JS/ES's boolean conversion is described in section 9.2 of the ECMA 262 standard.+--+boolFromESBooleanCoercionRules :: PHPSessionValue -> Bool+boolFromESBooleanCoercionRules var =+  case var of+    PHPSessionValueArray arr -> True+    PHPSessionValueBool b -> b+    PHPSessionValueFloat (Left i) -> i /= 0+    PHPSessionValueFloat (Right f) ->+      case f of+        0 -> False+        _ | isNaN f -> False+        _ -> True+    PHPSessionValueInt i -> i /= 0+    PHPSessionValueNull -> False+    PHPSessionValueObject _ arr -> True+    PHPSessionValueObjectSerializeable _ bstr -> True+    PHPSessionValueString str ->+      case str of+        ""  -> False+        _   -> True+    PHPSessionValueMisc _ _ -> True++-- | Alternative boolean coercion based on non-overloaded Perl 5 rules. +-- Values that return 'False' are the empty string \"\", the string containing+-- \"0\", 0, @/NULL/@ and @/FALSE/@.+-- +-- PHP objects, arrays and objects implementing Serializable always return 'True'. +--+-- Perl's boolean coercion rules are described in the section \"Truth and Falsehood\"+-- of \"perlsyn\".+-- <http://perldoc.perl.org/perlsyn.html#Truth-and-Falsehood>+--+boolFromPerlBooleanCoercionRules :: PHPSessionValue -> Bool+boolFromPerlBooleanCoercionRules var =+  case var of+    PHPSessionValueArray arr -> True+    PHPSessionValueBool b -> b+    PHPSessionValueFloat (Left i) -> i /= 0+    PHPSessionValueFloat (Right f) -> f /= 0+    PHPSessionValueInt i -> i /= 0+    PHPSessionValueNull -> False+    PHPSessionValueObject _ arr -> True+    PHPSessionValueObjectSerializeable _ bstr -> True+    PHPSessionValueString str ->+      case str of+        "0" -> False+        ""  -> False+        _   -> True+    PHPSessionValueMisc _ _ -> True++-- | Alternative boolean coercion based on non-overloaded Python rules. +-- Values that return 'False' are the empty array @/[]/@, the empty string+-- \"\", 0, @/NULL/@ and @/FALSE/@.+-- +-- PHP objects and objects implementing Serializable always return 'True'. +--+-- Python's boolean conversion rules are described in \"Truth Value Testing\"+-- in section 3.1 of Python 2.5's Library Reference.+-- <https://docs.python.org/release/2.5.2/lib/truth.html>+--+boolFromPythonBooleanCoercionRules :: PHPSessionValue -> Bool+boolFromPythonBooleanCoercionRules var =+  case var of+    PHPSessionValueArray arr ->+      case arr of+        [] -> False+        _  -> True+    PHPSessionValueBool b -> b+    PHPSessionValueFloat (Left i) -> i /= 0+    PHPSessionValueFloat (Right f) -> f /= 0+    PHPSessionValueInt i -> i /= 0+    PHPSessionValueNull -> False+    PHPSessionValueObject _ arr -> True+    PHPSessionValueObjectSerializeable _ bstr -> True+    PHPSessionValueString str ->+      case str of+        "" -> False+        _  -> True+    PHPSessionValueMisc _ _ -> True++-- | Alternative boolean coercion based on Lua rules, all values are 'True' except+-- @/NULL/@ and @/FALSE/@.+-- +-- For Lua's conversion rules, refer to the passage in section 2.4.4 \"Control+-- Structures\" of Lua 5.1's Manual.+-- <http://www.lua.org/manual/5.1/manual.html>+--+boolFromLuaBooleanCoercionRules :: PHPSessionValue -> Bool+boolFromLuaBooleanCoercionRules var =+  case var of+    PHPSessionValueArray _ -> True+    PHPSessionValueBool b  -> b+    PHPSessionValueFloat _ -> True+    PHPSessionValueInt i   -> True+    PHPSessionValueNull    -> False+    PHPSessionValueObject _ _ -> True+    PHPSessionValueObjectSerializeable _ _ -> True+    PHPSessionValueString str -> True+    PHPSessionValueMisc _ _   -> True++

@@ -0,0 +1,358 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}+-- |+-- Module : Data.PHPSession.ImplicitConv.PHPTypeCoercion+-- Copyright: (c) 2014 Edward Blake+-- License: BSD-style+-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Functions for performing conversion from 'PHPSessionValue' objects to Haskell+-- types while using a subset of the implicit PHP type coercion behaviour. Some+-- of the differences from the implicit type conversion found in PHP are noted:+--+-- * Conversions that are documented as undefined behaviour in the PHP manual+--   will throw definite exceptions with these functions.+--+-- * A significant difference from PHP's conversion rules is that @/NULL/@+--   cannot be directly converted to any data type except to 'Bool', otherwise+--   @/NULL/@ has to be handled by using the type @'Maybe' a@ to capture+--   nullable values.+--+-- * Objects that implement Serializable are not convertible to any other type+--   at all as their value systems are not directly interpretable in a meaningful+--   manner.+--+-- * Numbers can be converted to strings, but only strings that satisfy+--   @reads str = [(value, \"\")]@ can be converted back to numbers.+--+-- * Arrays and objects to string conversions which would normally be coerced+--   to the simple strings \"Array\" and \"Object\" in PHP, are simply considered+--   errors with these conversion functions.+--+module Data.PHPSession.ImplicitConv.PHPTypeCoercion (+    -- * Convert from 'PHPSessionValue'+    convFromPHPImplicit,+    convFromPHPImplicitSafe,+    -- * Type classes+    ConversionFromPHPImplicitValueOrMismatch(..)+) where++import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS+import Data.PHPSession.Types+import Data.PHPSession.ImplicitConv.ConvBool+import Data.Int (Int32, Int64)+import Data.List as L (foldl')+import Data.PHPSession.Conv++class ConversionFromPHPImplicitValueOrMismatch b where+  convFromPHPImplicitOM :: PHPSessionValue -> Either String b+++isScalarForArray v =+  case v of+    PHPSessionValueBool _     -> True+    PHPSessionValueFloat _    -> True+    PHPSessionValueInt _      -> True+    PHPSessionValueString _   -> True+    PHPSessionValueNull       -> False+    PHPSessionValueObjectSerializeable _ _ -> False+    PHPSessionValueMisc _ _   -> False+    PHPSessionValueObject _ _ -> False+    PHPSessionValueArray _    -> False+  +--+-- Refer to the following reference on array conversion at: +-- <http://php.net/manual/en/language.types.array.php#language.types.array.casting>+--+instance ConversionFromPHPImplicitValueOrMismatch [(PHPSessionValue,PHPSessionValue)] where+  -- Not converted to array:+  -- * PHPSessionValueNull (differs from PHP: PHP creates empty array)+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM v | isScalarForArray v = arrayScalarAsValue v+  convFromPHPImplicitOM (PHPSessionValueObject _cls arr) = Right arr+  convFromPHPImplicitOM (PHPSessionValueArray arr)       = Right arr+  convFromPHPImplicitOM v = mismatchError v "[(PHPSessionValue,PHPSessionValue)]"+++arrayScalarAsValue :: PHPSessionValue -> Either String [(PHPSessionValue,PHPSessionValue)]+arrayScalarAsValue r =+  Right ([(PHPSessionValueInt 0, r)])++convArrayScalarLeftSide :: ConversionFromPHPImplicitValueOrMismatch a => PHPSessionValue -> Either String [(a,PHPSessionValue)]+convArrayScalarLeftSide r = +  case convFromPHPImplicitOM (PHPSessionValueInt 0) of+    Left message -> Left message+    Right index ->+      Right ([(index, r)])++convArrayListLeftSide :: ConversionFromPHPImplicitValueOrMismatch a => [(PHPSessionValue,PHPSessionValue)] -> Either String [(a,PHPSessionValue)]+convArrayListLeftSide vars =+  case L.foldl' ontoTuple (Right []) vars of+    Left str -> Left str+    Right lst -> Right $ reverse lst+  where+    ontoTuple (Left str) _ = Left str+    ontoTuple (Right lst) (l,r) = +      let l' = convFromPHPImplicitOM l+       in case l' of+            Left errl -> Left errl+            Right l'' ->+              Right ((l'',r) : lst)++instance ConversionFromPHPImplicitValueOrMismatch b => ConversionFromPHPImplicitValueOrMismatch [(PHPSessionValue,b)] where+  -- Not converted to array:+  -- * PHPSessionValueNull (differs from PHP: PHP creates empty array)+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM v | isScalarForArray v = convArrayScalarRightSide v convFromPHPImplicitOM+  convFromPHPImplicitOM (PHPSessionValueObject _cls arr) = convArrayListRightSide arr convFromPHPImplicitOM+  convFromPHPImplicitOM (PHPSessionValueArray arr)       = convArrayListRightSide arr convFromPHPImplicitOM+  convFromPHPImplicitOM v = mismatchError v "ConversionFromPHPValueOrMismatch b => ConversionFromPHPValueOrMismatch [(PHPSessionValue,b)]"+++-- convArrayScalarRightSide :: ConversionFromPHPImplicitValueOrMismatch b => PHPSessionValue -> Either String [(PHPSessionValue,b)]+convArrayScalarRightSide r conv =+  case conv r of+    Left message -> Left message+    Right r' -> Right ([(PHPSessionValueInt 0, r')])++-- convArrayListRightSide :: ConversionFromPHPImplicitValueOrMismatch b => [(PHPSessionValue,PHPSessionValue)] -> Either String [(PHPSessionValue,b)]+convArrayListRightSide vars conv =+  case L.foldl' ontoTuple (Right []) vars of+    Left str -> Left str+    Right lst -> Right $ reverse lst+  where+    ontoTuple (Left str) _ = Left str+    ontoTuple (Right lst) (l,r) = +      case conv r of+        Left errr -> Left errr+        Right r'' ->+          Right $ (l,r'') : lst+++instance (ConversionFromPHPImplicitValueOrMismatch a, ConversionFromPHPImplicitValueOrMismatch b) => ConversionFromPHPImplicitValueOrMismatch [(a,b)] where+  -- Not converted to array:+  -- * PHPSessionValueNull (differs from PHP: PHP creates empty array)+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM v | isScalarForArray v = convArrayScalarBothSides v convFromPHPImplicitOM+  convFromPHPImplicitOM (PHPSessionValueObject _cls arr) = convArrayListBothSides arr convFromPHPImplicitOM+  convFromPHPImplicitOM (PHPSessionValueArray arr)       = convArrayListBothSides arr convFromPHPImplicitOM+  convFromPHPImplicitOM v = mismatchError v "(ConversionFromPHPValueOrMismatch a, ConversionFromPHPValueOrMismatch b) => ConversionFromPHPValueOrMismatch [(a,b)]"+++convArrayScalarBothSides+  :: ConversionFromPHPImplicitValueOrMismatch t1 =>+     t -> (t -> Either String t2) -> Either String [(t1, t2)]+convArrayScalarBothSides r conv = +  case convFromPHPImplicitOM (PHPSessionValueInt 0) of+    Left message -> Left message+    Right index ->+      case conv r of+        Left message' -> Left message'+        Right r' -> Right ([(index, r')])++-- convArrayListBothSides :: (ConversionFromPHPImplicitValueOrMismatch a, ConversionFromPHPImplicitValueOrMismatch b) => [(PHPSessionValue,PHPSessionValue)] -> Either String [(a,b)]+convArrayListBothSides vars conv = +  case L.foldl' ontoTuple (Right []) vars of+    Left str -> Left str+    Right lst -> Right $ reverse lst+  where+    ontoTuple (Left str) _ = Left str+    ontoTuple (Right lst) (l,r) = +      case convFromPHPImplicitOM l of+        Left errl -> Left errl+        Right l'' ->+          case conv r of+            Left errr -> Left errr+            Right r'' ->+              Right ((l'',r'') : lst)++{-+-- Sequenceable: +instance ConversionFromPHPImplicitValueOrMismatch [PHPSessionValue] where+  -- Not converted to array:+  -- * PHPSessionValueNull (differs from PHP: PHP creates empty array)+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM v | isScalarForArray v = Right [v]+  convFromPHPImplicitOM (PHPSessionValueObject _cls arr) = Right $ map (\(_,a) -> a) arr+  convFromPHPImplicitOM (PHPSessionValueArray arr) = Right $ map (\(_,a) -> a) arr+  convFromPHPImplicitOM v = mismatchError v "[PHPSessionValue]"+-}++-- Refer to Data.PHPSession.ImplicitConv.ConvBool for the boolean implicit+-- conversion.+--+instance ConversionFromPHPImplicitValueOrMismatch Bool where+  convFromPHPImplicitOM var =+    Right $ boolFromPHPLooseComparisonWithTrue var++-- Refer to the following reference for floating point conversion rules at+-- <http://php.net/manual/languages.types.float.php#language.types.float.casting>+--+instance ConversionFromPHPImplicitValueOrMismatch Double where+  convFromPHPImplicitOM (PHPSessionValueFloat (Right var)) = (Right) var+  convFromPHPImplicitOM (PHPSessionValueFloat (Left  var)) = (Right . fromIntegral) var+  convFromPHPImplicitOM (PHPSessionValueString str) =+    case reads str' of+      [(val,"")] -> Right val+      [] -> let v = PHPSessionValueString str+             in mismatchError v "Double"+    where+      str' = LBS.unpack str+  convFromPHPImplicitOM var =+    let intvar = convFromPHPImplicitOM var :: Either String Int+     in case intvar of+          Left message -> Left message+          Right intvar' ->+            (Right . fromIntegral) intvar'+++-- Refer to the following reference for integer conversion rules:+-- <http://php.net/manual/en/language.types.integer.php#language.types.integer.casting>+--+instance ConversionFromPHPImplicitValueOrMismatch Int where+  -- Not converted to Int:+  -- * PHPSessionValueArray+  -- * PHPSessionValueObject+  -- * PHPSessionValueNull+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM (PHPSessionValueBool b) = Right $ if b then 1 else 0+  convFromPHPImplicitOM (PHPSessionValueFloat lr) =+    Right $ case lr of+              Left i -> i+              Right f -> floor f+  convFromPHPImplicitOM (PHPSessionValueInt val) = Right $ fromIntegral val+  convFromPHPImplicitOM (PHPSessionValueString str) =+    case reads str' of+      [(val,"")] -> Right $ fromIntegral val+      [] ->+        case reads str' of+          [(valdbl,"")] -> Right $ floor valdbl+          [] -> let v = PHPSessionValueString str+                 in mismatchError v "Int"+    where str' = LBS.unpack str+  convFromPHPImplicitOM v = mismatchError v "Int"+instance ConversionFromPHPImplicitValueOrMismatch Int32 where+  convFromPHPImplicitOM var =+    let var' = convFromPHPImplicitOM var :: Either String Int+     in case var' of+          Left message -> Left message+          Right int -> Right $ fromIntegral int+instance ConversionFromPHPImplicitValueOrMismatch Int64 where+  convFromPHPImplicitOM var =+    let var' = convFromPHPImplicitOM var :: Either String Int+     in case var' of+          Left message -> Left message+          Right int -> Right $ fromIntegral int+++instance ConversionFromPHPImplicitValueOrMismatch (PHPSessionClassName, [(PHPSessionValue,PHPSessionValue)]) where+  -- Not converted to Object:+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM (PHPSessionValueArray arr) = Right (phpStdClass,arr)+  convFromPHPImplicitOM (PHPSessionValueBool b)  = Right (phpStdClass,[(phpScalarMember, PHPSessionValueBool b)])+  convFromPHPImplicitOM (PHPSessionValueFloat a) = Right (phpStdClass,[(phpScalarMember, PHPSessionValueFloat a)])+  convFromPHPImplicitOM (PHPSessionValueInt i)   = Right (phpStdClass,[(phpScalarMember, PHPSessionValueInt i)])+  convFromPHPImplicitOM (PHPSessionValueNull)    = Right (phpStdClass,[])+  convFromPHPImplicitOM (PHPSessionValueObject cls arr) = Right (cls,arr)+  convFromPHPImplicitOM (PHPSessionValueString a) = Right (phpStdClass,[(phpScalarMember, PHPSessionValueString a)])+  convFromPHPImplicitOM v = mismatchError v "(PHPSessionClassName, [(PHPSessionValue,PHPSessionValue)])"++phpStdClass = PHPSessionClassName "stdClass"+phpScalarMember = PHPSessionValueString "scalar"++instance ConversionFromPHPImplicitValueOrMismatch (PHPSessionClassName, LBS.ByteString) where+  -- Not converted to (and from) objects implementing Serializable:+  -- * PHPSessionValueArray+  -- * PHPSessionValueBool+  -- * PHPSessionValueFloat,+  -- * PHPSessionValueInt+  -- * PHPSessionValueNull+  -- * PHPSessionValueObject+  -- * PHPSessionValueString,+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM (PHPSessionValueObjectSerializeable cls arr) = Right (cls,arr)+  convFromPHPImplicitOM v = mismatchError v "(PHPSessionClassName, LBS.ByteString)"++--+--+instance ConversionFromPHPImplicitValueOrMismatch LBS.ByteString where+  -- Not converted to string:+  -- * PHPSessionValueArray+  -- * PHPSessionValueObject+  -- * PHPSessionValueObjectSerializeable+  -- * PHPSessionValueNull (differs from PHP: PHP creates empty string "")+  -- * PHPSessionValueMisc+  convFromPHPImplicitOM (PHPSessionValueBool b) =+     case b of+       True  -> Right "1"+       False -> Right ""+  convFromPHPImplicitOM (PHPSessionValueFloat a) =+    case a of+      Left i  -> (Right . LBS.pack . show) i+      Right f -> (Right . LBS.pack . show) f+  convFromPHPImplicitOM (PHPSessionValueInt i) =+    (Right . LBS.pack . show) i+  -- Unused: convFromPHPImplicitOM (PHPSessionValueNull) = Right ""+  convFromPHPImplicitOM (PHPSessionValueString var) = Right var+  convFromPHPImplicitOM v = mismatchError v "ByteString"++instance ConversionFromPHPImplicitValueOrMismatch BS.ByteString where+  convFromPHPImplicitOM var =+    let var' = convFromPHPImplicitOM var :: Either String LBS.ByteString+     in case var' of+          Left message -> Left message+          Right str -> Right (BS.concat $ LBS.toChunks str)++instance ConversionFromPHPImplicitValueOrMismatch a => ConversionFromPHPImplicitValueOrMismatch (Maybe a) where+  convFromPHPImplicitOM PHPSessionValueNull = Right Nothing+  convFromPHPImplicitOM v =+    case convFromPHPImplicitOM v of+      Left s -> Left s+      Right b' -> Right (Just b')+  ++mismatchError v totype =+  Left $ "Type mismatch converting from (" ++ show v ++ ") to " ++ totype++-- | 'convFromPHPImplicit' and 'convFromPHPImplicitSafe' are functions that convert+-- values stored as 'PHPSessionValue' into appropriate Haskell types depending on+-- the desired type cast or inferred. Unlike the 'convFrom' and 'convFromSafe' +-- functions provided in "Data.PHPSession.Conv", functions provided in this module +-- perform type coercion based on a significant number of conversion rules to+-- satisfy the type cast or inferred.+--+-- The example @arrayOfPHPStrings@ definition given in the example documented in+-- "Data.PHPSession.Conv" can be evaluated to @[(0,\"Hello\"),(1,\"World\")]@.+-- +-- >>> convFromPHPImplicit arrayOfPHPStrings :: [(Int,LBS.ByteString)]+-- [(0,"Hello"),(1,"World")]+--+-- However, if the desired type signature is changed:+--+-- >>> convFromPHPImplicit arrayOfPHPStrings :: [(LBS.ByteString,LBS.ByteString)]+-- [("0","Hello"),("1","World")]+--+-- Where there is the possibility that the value being sought may be @/NULL/@, the+-- type should be @('Maybe' a)@.+--+convFromPHPImplicit :: ConversionFromPHPImplicitValueOrMismatch b => PHPSessionValue -> b+convFromPHPImplicit var =+    case convFromPHPImplicitOM var of+      Left message -> error message+      Right var' -> var'++-- | 'convFromPHPImplicitSafe' is a version of 'convFromPHPImplicit' that returns a+-- 'Left' with an error message instead of throwing a run time exception.+--+convFromPHPImplicitSafe+  :: ConversionFromPHPImplicitValueOrMismatch b =>+     PHPSessionValue -> Either String b+convFromPHPImplicitSafe var = convFromPHPImplicitOM var

@@ -1,5 +1,5 @@ name:                hs-php-session
-version:             0.0.9.2
+version:             0.0.9.3
 synopsis:            PHP session and values serialization
 description:         
     A library for encoding and decoding serialized PHP sessions in the format
@@ -24,6 +24,9 @@   exposed-modules:
     Data.PHPSession
     Data.PHPSession.Types
+    Data.PHPSession.Conv
+    Data.PHPSession.ImplicitConv.ConvBool
+    Data.PHPSession.ImplicitConv.PHPTypeCoercion
   -- other-modules:       
   build-depends:       
                        base == 4.*,