-- | The Map module provides tools for developing function space 'Manifold's.
-- A map is a 'Manifold' where the 'Point's of the Manifold represent
-- parametric functions between 'Manifold's. The defining feature of 'Map's is
-- that they have a particular 'Domain' and 'Codomain', which themselves are
-- 'Manifold's.

module Goal.Geometry.Map (
    -- * Maps
      Map (Domain, domain, Codomain, codomain)
    , Apply ((>.>), (>$>))
    -- * Map Charts
    , Function (Function)
    ) where


--- Imports ---


-- Goal --

import Goal.Geometry.Manifold

--- Maps between Manifolds ---

-- Charts on Maps --

data Function c d = Function c d
-- | 'Function' Charts help track Charts on the 'Domain' and 'Codomain'. The
-- first Chart corresponds to the 'Domain's chart.

class Manifold m => Map m where
    type Domain m :: *
    domain :: m -> Domain m
    type Codomain m :: *
    codomain :: m -> Codomain m

class Map m => Apply c d m where
    -- | 'Map' application.
    (>.>) :: Function c d :#: m -> c :#: Domain m -> d :#: Codomain m
    (>.>) f x = head $ f >$> [x]
    -- | 'Map' list application. May sometimes have a more efficient implementation
    -- than simply list-mapping (>.>).
    (>$>) :: Function c d :#: m -> [c :#: Domain m] -> [d :#: Codomain m]
    (>$>) f = map (f >.>)

infix 8 >.>
infix 8 >$>



{-
--- Tables ---


newtype Table s = Table s deriving (Eq, Read, Show)


--- Instances ---


-- Table --

instance Discrete s => Manifold (Table s) where
    dimension (Table s) = length $ elements s

instance Discrete s => Function Cartesian (Table s) where
    type Domain Cartesian (Table s) = s
    domain cm = let (Table s) = manifold cm in s
    type Codomain Cartesian (Table s) = Continuum
    codomain _ = Continuum
    (>.>) cm k =
        let ctgs = listCoordinates cm
            Just (ctg,_) = find ((==k) . snd) . zip ctgs . elements $ domain cm
         in ctg
    (>$>) cm ks = (cm >.>) <$> ks
-}