module Data.View (
  -- * Views
  View(..)
  -- ** Usual Views
  ,fst_,snd_,head_,tail_,id_,f_
  -- ** View-related functions
  ,on,(>>>),(<<<)) where

import Prelude hiding ((.),id)
import Control.Category

{-|
The type definition of a view from @a@ to @v@.

Views allow you to operate on part (the /view/) of a data structure (the /whole/)
while abstracting the rest.
-}
data View a v = View {
  extract :: a -> v,      -- ^ Function to extract the view from the whole
  inject :: v -> a -> a   -- ^ Function to reinject the view into the whole
  }
{-^
Note that while views are mostly used for operating on record fields, there are
very interesting abstractions that may be conceived from them having nothing
whatsoever to do with fields (for example, a view for the bounds of an array,
that allows for easy redimensioning, or a view for the associated value to a
given key in a map)
-}
instance Category View where
  id = id_
  View u u' . View v v' = View (u . v) (\x a -> v' (u' x (v a)) a)

-- |A view for the first element of a pair
fst_ = View fst (\x ~(_,b) -> (x,b))
-- |A view for the second element of a pair
snd_ = View snd (\y ~(a,_) -> (a,y))
-- |A view for the head of a list
head_ = View head (\h (_:t) -> h:t)
-- |A view for the tail of a list
tail_ = View tail (\t (h:_) -> h:t)
-- |The identity view
id_ = View id const
-- |A view that encapsulates a function.
f_ f = View f (error "invalid function view injection")
{-^
/Note:/ A View created with 'f_' is not a full View, as it doesn't allow
reinjection of the view into the whole. This function is thus to be
used only for convenience when chaining Views and pure functions.
-}

-- |@f `on` v@ expands @f@ to act on the whole of v. 
f `on` View v v' = \x -> v' (f (v x)) x