{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

module Database.Postgis.Trivial.Cast where

import GHC.Base hiding ( foldr )
import GHC.Num ( Num((+)) )
import Control.Monad ( replicateM, mapM_ )
import Data.Functor ( (<$>), (<&>) )
import Data.Typeable    ( Typeable )
import Data.Foldable    ( Foldable(..) )
import Data.Traversable ( Traversable(..) )
import qualified Data.Vector as V
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.List (zip)

import Database.Postgis.Trivial.Types
import Database.Postgis.Trivial.Internal


-- | 'Type cast' type family
type family Cast p

-- | 'Type cast' procedures
class (Typeable p, PointND (Cast p)) => Castable p where
    toPointND :: p -> Cast p
    fromPointND :: Cast p -> p

-- | Translator of Traversables
class (Castable p, Traversable t, Typeable t) => Trans t p where
    transTo :: t p -> t (Cast p)
    transTo t p
vs = p -> Cast p
forall p. Castable p => p -> Cast p
toPointND (p -> Cast p) -> t p -> t (Cast p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t p
vs
    transFrom :: t (Cast p) -> t p
    transFrom t (Cast p)
vs = Cast p -> p
forall p. Castable p => Cast p -> p
fromPointND (Cast p -> p) -> t (Cast p) -> t p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (Cast p)
vs

instance Castable p => Trans [] p where
instance Castable p => Trans V.Vector p where
instance (Castable p, Typeable k) => Trans (M.Map k) p where
instance Castable p => Trans IM.IntMap p where

-- | Replication procedure for different Traversables
class (Traversable t, Typeable t) => Repl t b where
    repl :: Int -> HeaderGetter b -> HeaderGetter (t b)

instance Repl [] b where
    repl :: Int -> HeaderGetter b -> HeaderGetter [b]
repl = Int -> HeaderGetter b -> HeaderGetter [b]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
instance Repl V.Vector b where
    repl :: Int -> HeaderGetter b -> HeaderGetter (Vector b)
repl = Int -> HeaderGetter b -> HeaderGetter (Vector b)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM

-- | Point chain is a base structural component of geometries
class Traversable t => GeoChain t where
    count :: t p -> Int
    putChain :: PointND a => Putter (t a)
    putChain t a
vs = do
        Putter Int
putChainLen Putter Int -> Putter Int
forall a b. (a -> b) -> a -> b
$ t a -> Int
forall p. t p -> Int
forall (t :: * -> *) p. GeoChain t => t p -> Int
count t a
vs
        (a -> Put) -> t a -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall a. PointND a => Putter a
putPointND t a
vs
    getChain :: (Traversable t, PointND a) => HeaderGetter (t a)
    -- {-# MINIMAL count | putChain #-}

instance GeoChain V.Vector where
    count :: forall p. Vector p -> Int
count = Vector p -> Int
forall p. Vector p -> Int
V.length
    getChain :: forall a.
(Traversable Vector, PointND a) =>
HeaderGetter (Vector a)
getChain = HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> ReaderT Header Get (Vector a))
-> ReaderT Header Get (Vector a)
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ReaderT Header Get a -> ReaderT Header Get (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
`V.replicateM` ReaderT Header Get a
forall a. PointND a => HeaderGetter a
getPointND)
instance GeoChain [] where
    count :: forall p. [p] -> Int
count = (p -> Int -> Int) -> Int -> [p] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\p
_ Int
r->Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
0::Int)
    getChain :: forall a. (Traversable [], PointND a) => HeaderGetter [a]
getChain = HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> ReaderT Header Get [a]) -> ReaderT Header Get [a]
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ReaderT Header Get a -> ReaderT Header Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
`replicateM` ReaderT Header Get a
forall a. PointND a => HeaderGetter a
getPointND)
instance GeoChain (M.Map Int) where
    count :: forall p. Map Int p -> Int
count = Map Int p -> Int
forall k a. Map k a -> Int
M.size
    getChain :: forall a.
(Traversable (Map Int), PointND a) =>
HeaderGetter (Map Int a)
getChain = (HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> ReaderT Header Get [a]) -> ReaderT Header Get [a]
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ReaderT Header Get a -> ReaderT Header Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
`replicateM` ReaderT Header Get a
forall a. PointND a => HeaderGetter a
getPointND)) ReaderT Header Get [a]
-> ([a] -> Map Int a) -> ReaderT Header Get (Map Int a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        ([(Int, a)] -> Map Int a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, a)] -> Map Int a)
-> ([a] -> [(Int, a)]) -> [a] -> Map Int a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..]::[Int]))
instance GeoChain IM.IntMap where
    count :: forall p. IntMap p -> Int
count = IntMap p -> Int
forall p. IntMap p -> Int
IM.size
    getChain :: forall a.
(Traversable IntMap, PointND a) =>
HeaderGetter (IntMap a)
getChain = (HeaderGetter Int
getChainLen HeaderGetter Int
-> (Int -> ReaderT Header Get [a]) -> ReaderT Header Get [a]
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ReaderT Header Get a -> ReaderT Header Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
`replicateM` ReaderT Header Get a
forall a. PointND a => HeaderGetter a
getPointND)) ReaderT Header Get [a]
-> ([a] -> IntMap a) -> ReaderT Header Get (IntMap a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        ([(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, a)] -> IntMap a) -> ([a] -> [(Int, a)]) -> [a] -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0..]::[Int]))