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

-}

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

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

-}

module Data.Convertible.Utils(boundedConversion,
                             convertVia
                             )
where
import Prelude
import Data.Convertible.Base
import Data.Typeable

{- | Utility function to perform bounds checking as part of a conversion.

Does this be examining the bounds of the destination type, converting to the type of
the source via 'safeConvert', comparing to the source value.  Results in an error
if the conversion is out of bounds. -}
boundedConversion :: (Ord a, Bounded b, Show a, Show b, Convertible a Integer,
                      Convertible b Integer,
                      Typeable a, Typeable b) => 
                     (a -> ConvertResult b) -- ^ Function to do the conversion
                  -> a                      -- ^ Input data
                  -> ConvertResult b        -- ^ Result
boundedConversion :: forall a b.
(Ord a, Bounded b, Show a, Show b, Convertible a Integer,
 Convertible b Integer, Typeable a, Typeable b) =>
(a -> ConvertResult b) -> a -> ConvertResult b
boundedConversion (a -> ConvertResult b
func :: (a -> ConvertResult b)) a
inp =
    do b
result <- a -> ConvertResult b
func a
inp
       let smallest :: b
smallest = forall a. a -> a -> a
asTypeOf forall a. Bounded a => a
minBound b
result
       let biggest :: b
biggest = forall a. a -> a -> a
asTypeOf forall a. Bounded a => a
maxBound b
result
       let smallest' :: Integer
smallest' = (forall a b. Convertible a b => a -> b
convert b
smallest)::Integer
       let biggest' :: Integer
biggest' = (forall a b. Convertible a b => a -> b
convert b
biggest)::Integer
       let inp' :: Integer
inp' = (forall a b. Convertible a b => a -> b
convert a
inp)::Integer
       if Integer
inp' forall a. Ord a => a -> a -> Bool
< Integer
smallest' Bool -> Bool -> Bool
|| Integer
inp' forall a. Ord a => a -> a -> Bool
> Integer
biggest'
          then forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError (String
"Input value outside of bounds: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (b
smallest, b
biggest))
               a
inp :: ConvertResult b
          else forall (m :: * -> *) a. Monad m => a -> m a
return b
result :: ConvertResult b

ifThenElse :: Bool -> t -> t -> t
ifThenElse :: forall t. Bool -> t -> t -> t
ifThenElse Bool
b t
c t
d 
   | Bool
b = t
c
   | Bool
otherwise = t
d

{- | Useful for defining conversions that are implemented in terms of other
conversions via an intermediary type. Instead of:

>instance Convertible CalendarTime POSIXTime where
>    safeConvert a = do r <- safeConvert a
>                       safeConvert (r :: ClockTime)

we can now write:

>instance Convertible CalendarTime POSIXTime where
>    safeConvert = convertVia (undefined::ClockTime)

which does the same thing -- converts a CalendarTime to a ClockTime, then a
ClockTime to a POSIXTime, both using existing 'Convertible' instances.
 -}
convertVia :: (Convertible a b, Convertible b c) =>
              b                 -- ^ Dummy data to establish intermediate type - can be undefined
           -> a                 -- ^ Input value
           -> ConvertResult c   -- ^ Result
convertVia :: forall a b c.
(Convertible a b, Convertible b c) =>
b -> a -> ConvertResult c
convertVia b
dummy a
inp =
    do b
r1 <- forall a b. Convertible a b => a -> ConvertResult b
safeConvert a
inp
       forall a b. Convertible a b => a -> ConvertResult b
safeConvert (forall a. a -> a -> a
asTypeOf b
r1 b
dummy)