{-# OPTIONS_GHC -Wno-deprecations #-}
{- 
Borrowed from package convertible-1.1.1.0.  

We cannot use convertible directly as some of its dependencies do not compile on ghcjs.
-}

{-
Copyright (C) 2009-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE in package convertible.

-}

{- |
   Module     : Data.Convertible.Base
   Copyright  : Copyright (C) 2009-2011 John Goerzen
   License    : BSD3

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

-}

module Data.Convertible.Base( -- * The conversion process
                              convert,
                              Convertible(..),
                              -- * Handling the results
                              ConvertResult,
                              ConvertError(..),
                              convError,
                              prettyConvertError
                             )
where
import Prelude
import Control.Monad.Error
import Data.Typeable

{- | The result of a safe conversion via 'safeConvert'. -}
type ConvertResult a = Either ConvertError a

----------------------------------------------------------------------
-- Conversions
----------------------------------------------------------------------

{- | A typeclass that represents something that can be converted.
A @Convertible a b@ instance represents an @a@ that can be converted to a @b@. -}
class Convertible a b where
    {- | Convert @a@ to @b@, returning Right on success and Left on error.
       For a simpler interface, see 'convert'. -}
    safeConvert :: a -> ConvertResult b

{-
{- | Any type can be converted to itself. -}
instance Convertible a a where
    safeConvert x = return x
-}

{-
{- | Lists of any convertible type can be converted. -}
instance Convertible a b => Convertible [a] [b] where
    safeConvert = mapM safeConvert
-}

{- | Convert from one type of data to another.  Raises an exception if there is
an error with the conversion.  For a function that does not raise an exception
in that case, see 'safeConvert'. -}
convert :: Convertible a b => a -> b
convert :: a -> b
convert a
x = 
    case a -> ConvertResult b
forall a b. Convertible a b => a -> ConvertResult b
safeConvert a
x of
      Left ConvertError
e -> [Char] -> b
forall a. HasCallStack => [Char] -> a
error (ConvertError -> [Char]
prettyConvertError ConvertError
e)
      Right b
r -> b
r

{-
instance Convertible Int Double where
    safeConvert = return . fromIntegral
instance Convertible Double Int where
    safeConvert = return . truncate         -- could do bounds checking here
instance Convertible Integer Double where
    safeConvert = return . fromIntegral
instance Convertible Double Integer where
    safeConvert = return . truncate
-}

----------------------------------------------------------------------
-- Error Handling
----------------------------------------------------------------------

{- | How we indicate that there was an error. -}
data ConvertError = ConvertError {
      ConvertError -> [Char]
convSourceValue :: String,
      ConvertError -> [Char]
convSourceType :: String,
      ConvertError -> [Char]
convDestType :: String,
      ConvertError -> [Char]
convErrorMessage :: String}
                    deriving (ConvertError -> ConvertError -> Bool
(ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool) -> Eq ConvertError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConvertError -> ConvertError -> Bool
$c/= :: ConvertError -> ConvertError -> Bool
== :: ConvertError -> ConvertError -> Bool
$c== :: ConvertError -> ConvertError -> Bool
Eq, ReadPrec [ConvertError]
ReadPrec ConvertError
Int -> ReadS ConvertError
ReadS [ConvertError]
(Int -> ReadS ConvertError)
-> ReadS [ConvertError]
-> ReadPrec ConvertError
-> ReadPrec [ConvertError]
-> Read ConvertError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConvertError]
$creadListPrec :: ReadPrec [ConvertError]
readPrec :: ReadPrec ConvertError
$creadPrec :: ReadPrec ConvertError
readList :: ReadS [ConvertError]
$creadList :: ReadS [ConvertError]
readsPrec :: Int -> ReadS ConvertError
$creadsPrec :: Int -> ReadS ConvertError
Read, Int -> ConvertError -> ShowS
[ConvertError] -> ShowS
ConvertError -> [Char]
(Int -> ConvertError -> ShowS)
-> (ConvertError -> [Char])
-> ([ConvertError] -> ShowS)
-> Show ConvertError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConvertError] -> ShowS
$cshowList :: [ConvertError] -> ShowS
show :: ConvertError -> [Char]
$cshow :: ConvertError -> [Char]
showsPrec :: Int -> ConvertError -> ShowS
$cshowsPrec :: Int -> ConvertError -> ShowS
Show)

instance Error ConvertError where
    strMsg :: [Char] -> ConvertError
strMsg [Char]
x = [Char] -> [Char] -> [Char] -> [Char] -> ConvertError
ConvertError [Char]
"(unknown)" [Char]
"(unknown)" [Char]
"(unknown)" [Char]
x

convError' :: (Show a, Typeable a, Typeable b) =>
               String -> a -> b -> ConvertResult b
convError' :: [Char] -> a -> b -> ConvertResult b
convError' [Char]
msg a
inpval b
retval = 
     ConvertError -> ConvertResult b
forall a b. a -> Either a b
Left (ConvertError -> ConvertResult b)
-> ConvertError -> ConvertResult b
forall a b. (a -> b) -> a -> b
$ ConvertError :: [Char] -> [Char] -> [Char] -> [Char] -> ConvertError
ConvertError {
             convSourceValue :: [Char]
convSourceValue = a -> [Char]
forall a. Show a => a -> [Char]
show a
inpval,
             convSourceType :: [Char]
convSourceType = TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (TypeRep -> [Char]) -> (a -> TypeRep) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a -> [Char]) -> a -> [Char]
forall a b. (a -> b) -> a -> b
$ a
inpval,
             convDestType :: [Char]
convDestType = TypeRep -> [Char]
forall a. Show a => a -> [Char]
show (TypeRep -> [Char]) -> (b -> TypeRep) -> b -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (b -> [Char]) -> b -> [Char]
forall a b. (a -> b) -> a -> b
$ b
retval,
             convErrorMessage :: [Char]
convErrorMessage = [Char]
msg}
    
convError :: (Show a, Typeable a, Typeable b) =>
             String -> a -> ConvertResult b
convError :: [Char] -> a -> ConvertResult b
convError [Char]
msg a
inpval = 
    [Char] -> a -> b -> ConvertResult b
forall a b.
(Show a, Typeable a, Typeable b) =>
[Char] -> a -> b -> ConvertResult b
convError' [Char]
msg a
inpval b
forall a. HasCallStack => a
undefined
    
prettyConvertError :: ConvertError -> String
prettyConvertError :: ConvertError -> [Char]
prettyConvertError (ConvertError [Char]
sv [Char]
st [Char]
dt [Char]
em) =
    [Char]
"Convertible: error converting source data " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
sv [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" of type " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
st
    [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to type " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dt [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
em