{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- 'Transport' abstraction layer.
--
-- This library provides a common interface for representing data as
-- JSON or XML-Rpc data. The common structure is captured in the 'Trans'
-- type.
--
-- To use it you'll need one of the backend implementations,
-- 'Data.Autolib.Transport.JSON' or 'Data.Autolib.Transport.HaXR'.

module Data.Autolib.Transport (
    module Data.Autolib.Transport.Class,
    module Data.Autolib.Transport.Atom,
    module Data.Autolib.Transport.Error,
    -- module Data.Derive.ToTransport
    -- and lots of instances
) where

import Data.Autolib.Transport.Class
import Data.Autolib.Transport.Atom
import Data.Autolib.Transport.Error
-- import Data.Derive.ToTransport (makeToTransport, derives)

import Data.ByteString (ByteString)
import Data.Text       (Text, pack, unpack)
import qualified Data.Set as S
import qualified Data.Map as M

instance ToTransport () where
    toTransport :: forall atom. Atom atom => () -> Trans atom
toTransport   () = [Trans atom] -> Trans atom
forall atom. [Trans atom] -> Trans atom
TrArray []
    fromTransport :: forall atom. Atom atom => Trans atom -> Error ()
fromTransport (TrArray []) = () -> Error ()
forall a. a -> Error a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    fromTransport Trans atom
_ = String -> Error ()
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected empty TrArray"

instance (ToTransport a, ToTransport b) => ToTransport (a, b) where
    toTransport :: forall atom. Atom atom => (a, b) -> Trans atom
toTransport (a
a, b
b) = [Trans atom] -> Trans atom
forall atom. [Trans atom] -> Trans atom
TrArray [a -> Trans atom
forall atom. Atom atom => a -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport a
a, b -> Trans atom
forall atom. Atom atom => b -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport b
b]
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (a, b)
fromTransport (TrArray [Trans atom
a, Trans atom
b]) = do
        a' <- Trans atom -> Error a
forall atom. Atom atom => Trans atom -> Error a
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
a
        b' <- fromTransport b
        return (a', b')
    fromTransport Trans atom
_ = String -> Error (a, b)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected two-element TrArray"

instance (ToTransport a, ToTransport b, ToTransport c)
    => ToTransport (a, b, c) where
    toTransport :: forall atom. Atom atom => (a, b, c) -> Trans atom
toTransport (a
a, b
b, c
c)
        = [Trans atom] -> Trans atom
forall atom. [Trans atom] -> Trans atom
TrArray [a -> Trans atom
forall atom. Atom atom => a -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport a
a, b -> Trans atom
forall atom. Atom atom => b -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport b
b, c -> Trans atom
forall atom. Atom atom => c -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport c
c]
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (a, b, c)
fromTransport (TrArray [Trans atom
a, Trans atom
b, Trans atom
c]) = do
        a' <- Trans atom -> Error a
forall atom. Atom atom => Trans atom -> Error a
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
a
        b' <- fromTransport b
        c' <- fromTransport c
        return (a', b', c')
    fromTransport Trans atom
_ = String -> Error (a, b, c)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected three-element TrArray"

instance ToTransport a => ToTransport [a] where
    toTransport :: forall atom. Atom atom => [a] -> Trans atom
toTransport = [a] -> Trans atom
forall atom. Atom atom => [a] -> Trans atom
forall a atom. (ToTransport a, Atom atom) => [a] -> Trans atom
toTransportList
    fromTransport :: forall atom. Atom atom => Trans atom -> Error [a]
fromTransport = Trans atom -> Error [a]
forall atom. Atom atom => Trans atom -> Error [a]
forall a atom.
(ToTransport a, Atom atom) =>
Trans atom -> Error [a]
fromTransportList

instance (Ord a, ToTransport a) => ToTransport (S.Set a) where
    toTransport :: forall atom. Atom atom => Set a -> Trans atom
toTransport = [Trans atom] -> Trans atom
forall atom. [Trans atom] -> Trans atom
TrArray ([Trans atom] -> Trans atom)
-> (Set a -> [Trans atom]) -> Set a -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Trans atom) -> [a] -> [Trans atom]
forall a b. (a -> b) -> [a] -> [b]
map a -> Trans atom
forall atom. Atom atom => a -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport ([a] -> [Trans atom]) -> (Set a -> [a]) -> Set a -> [Trans atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (Set a)
fromTransport (TrArray [Trans atom]
xs) = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Error [a] -> Error (Set a)
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Trans atom -> Error a) -> [Trans atom] -> Error [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Trans atom -> Error a
forall atom. Atom atom => Trans atom -> Error a
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport [Trans atom]
xs
    fromTransport Trans atom
_ = String -> Error (Set a)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrArray"

instance (Ord a, ToTransport a, ToTransport b) => ToTransport (M.Map a b) where
    toTransport :: forall atom. Atom atom => Map a b -> Trans atom
toTransport = [Trans atom] -> Trans atom
forall atom. [Trans atom] -> Trans atom
TrArray ([Trans atom] -> Trans atom)
-> (Map a b -> [Trans atom]) -> Map a b -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Trans atom) -> [(a, b)] -> [Trans atom]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> Trans atom
forall atom. Atom atom => (a, b) -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport ([(a, b)] -> [Trans atom])
-> (Map a b -> [(a, b)]) -> Map a b -> [Trans atom]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (Map a b)
fromTransport (TrArray [Trans atom]
xs) = [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, b)] -> Map a b) -> Error [(a, b)] -> Error (Map a b)
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Trans atom -> Error (a, b)) -> [Trans atom] -> Error [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Trans atom -> Error (a, b)
forall atom. Atom atom => Trans atom -> Error (a, b)
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport [Trans atom]
xs
    fromTransport Trans atom
_ = String -> Error (Map a b)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrArray"

instance (ToTransport a, ToTransport b) => ToTransport (Either a b) where
    toTransport :: forall atom. Atom atom => Either a b -> Trans atom
toTransport (Left  a
a) = [(String, Trans atom)] -> Trans atom
forall atom. [(String, Trans atom)] -> Trans atom
TrObject [(String
"Left",  a -> Trans atom
forall atom. Atom atom => a -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport a
a)]
    toTransport (Right b
b) = [(String, Trans atom)] -> Trans atom
forall atom. [(String, Trans atom)] -> Trans atom
TrObject [(String
"Right", b -> Trans atom
forall atom. Atom atom => b -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport b
b)]
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (Either a b)
fromTransport (TrObject [(String
"Left",  Trans atom
a)]) = a -> Either a b
forall a b. a -> Either a b
Left  (a -> Either a b) -> Error a -> Error (Either a b)
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Trans atom -> Error a
forall atom. Atom atom => Trans atom -> Error a
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
a
    fromTransport (TrObject [(String
"Right", Trans atom
b)]) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Error b -> Error (Either a b)
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Trans atom -> Error b
forall atom. Atom atom => Trans atom -> Error b
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
b
    fromTransport Trans atom
_ = String -> Error (Either a b)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrObject with a Left or a Right field"

instance ToTransport a => ToTransport (Maybe a) where
    toTransport :: forall atom. Atom atom => Maybe a -> Trans atom
toTransport Maybe a
Nothing = [(String, Trans atom)] -> Trans atom
forall atom. [(String, Trans atom)] -> Trans atom
TrObject [(String
"Nothing",  () -> Trans atom
forall atom. Atom atom => () -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport ())]
    toTransport (Just a
a) = [(String, Trans atom)] -> Trans atom
forall atom. [(String, Trans atom)] -> Trans atom
TrObject [(String
"Just", a -> Trans atom
forall atom. Atom atom => a -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport a
a)]
    fromTransport :: forall atom. Atom atom => Trans atom -> Error (Maybe a)
fromTransport (TrObject [(String
"Nothing", Trans atom
_)]) = Maybe a -> Error (Maybe a)
forall a. a -> Error a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    fromTransport (TrObject [(String
"Just", Trans atom
a)]) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Error a -> Error (Maybe a)
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Trans atom -> Error a
forall atom. Atom atom => Trans atom -> Error a
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
a
    fromTransport Trans atom
_ = String -> Error (Maybe a)
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrObject with an option value"

instance ToTransport Int where
    toTransport :: forall atom. Atom atom => Int -> Trans atom
toTransport = Integer -> Trans atom
forall atom. Atom atom => Integer -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport (Integer -> Trans atom) -> (Int -> Integer) -> Int -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Int
fromTransport Trans atom
x = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Error Integer -> Error Int
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Trans atom -> Error Integer
forall atom. Atom atom => Trans atom -> Error Integer
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport Trans atom
x

-- instances for atoms
instance ToTransport Integer where
    toTransport :: forall atom. Atom atom => Integer -> Trans atom
toTransport = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom) -> (Integer -> atom) -> Integer -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Integer
fromTransport (TrAtom atom
x) = atom -> Error Integer
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransport Trans atom
_ = String -> Error Integer
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"

instance ToTransport Double where
    toTransport :: forall atom. Atom atom => Double -> Trans atom
toTransport = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom) -> (Double -> atom) -> Double -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Double
fromTransport (TrAtom atom
x) = atom -> Error Double
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransport Trans atom
_ = String -> Error Double
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"

instance ToTransport Char where
    toTransport :: forall atom. Atom atom => Char -> Trans atom
toTransport = String -> Trans atom
forall atom. Atom atom => String -> Trans atom
forall a atom. (ToTransport a, Atom atom) => [a] -> Trans atom
toTransportList (String -> Trans atom) -> (Char -> String) -> Char -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Char
fromTransport Trans atom
x = do
        [c] <- Trans atom -> Error String
forall atom. Atom atom => Trans atom -> Error String
forall a atom.
(ToTransport a, Atom atom) =>
Trans atom -> Error [a]
fromTransportList Trans atom
x
        return c

    toTransportList :: forall atom. Atom atom => String -> Trans atom
toTransportList = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom) -> (String -> atom) -> String -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransportList :: forall atom. Atom atom => Trans atom -> Error String
fromTransportList (TrAtom atom
x) = atom -> Error String
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransportList Trans atom
_ = String -> Error String
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"

instance ToTransport ByteString where
    toTransport :: forall atom. Atom atom => ByteString -> Trans atom
toTransport = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom)
-> (ByteString -> atom) -> ByteString -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransport :: forall atom. Atom atom => Trans atom -> Error ByteString
fromTransport (TrAtom atom
x) = atom -> Error ByteString
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransport Trans atom
_ = String -> Error ByteString
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"

instance ToTransport Bool where
    toTransport :: forall atom. Atom atom => Bool -> Trans atom
toTransport = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom) -> (Bool -> atom) -> Bool -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Bool
fromTransport (TrAtom atom
x) = atom -> Error Bool
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransport Trans atom
_ = String -> Error Bool
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"

instance ToTransport Text where
    toTransport :: forall atom. Atom atom => Text -> Trans atom
toTransport = atom -> Trans atom
forall atom. atom -> Trans atom
TrAtom (atom -> Trans atom) -> (Text -> atom) -> Text -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> atom
forall a b. ConvertAtom a b => b -> a
toAtom
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Text
fromTransport (TrAtom atom
x) = atom -> Error Text
forall a b. ConvertAtom a b => a -> Error b
fromAtom atom
x
    fromTransport Trans atom
_ = String -> Error Text
forall a. String -> Error a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected TrAtom"