Examples.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Pointless.Lenses.Examples.Examples
-- Copyright   :  (c) 2009 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Lenses:
-- bidirectional lenses with point-free programming
-- 
-- This module provides examples, examples and more examples.
--
-----------------------------------------------------------------------------

module Generics.Pointless.Lenses.Examples.Examples where

import Generics.Pointless.Combinators
import Generics.Pointless.Functors
import Generics.Pointless.Fctrable
import Generics.Pointless.Bifunctors
import Generics.Pointless.Bifctrable
import Generics.Pointless.Lenses
import Generics.Pointless.Lenses.Combinators
import Generics.Pointless.Lenses.RecursionPatterns
import Generics.Pointless.Lenses.Reader.RecursionPatterns

-- | List length lens.
length_lns :: a -> Lens [a] Nat
length_lns a = nat_lns _L (\x -> id_lns -|-< snd_lns a)

-- | List zipping lens.
-- The aux transformation is merely for simplifying the constant argument
zip_lns :: Either (Either One (b,[b])) (a,[a]) -> Lens ([a],[b]) [(a,b)]
zip_lns c = ana_lns _L (((!<) c .< aux -|-< distp_lns) .< coassocl_lns .< dists_lns .< (out_lns ><< out_lns))
    where aux = (fst_lns _L -|-< snd_lns _L) -|-< fst_lns _L

-- | List filtering lens.
-- The argument passed to @snd_lns@ can be undefined because it will never be used
filter_lns :: Lens [Either a b] [a]
filter_lns = cata_lns _L ((inn_lns .\/< snd_lns _L) .< coassocl_lns .< (id_lns -|-< distl_lns))

-- | List mapping lens.
map_lns :: Lens c a -> Lens [c] [a]
map_lns f = nat_lns _L (\x -> id_lns -|-< f ><< id_lns)

-- | Generic mapping example using user-defined concrete generators
data T a = Fst a | Next (T a) deriving (Eq,Show)

type instance BF T = BPar :+| BId
type instance PF (T a) = Const a :+: Id

instance Mu (T a) where
    inn (Left x) = Fst x
    inn (Right x) = Next x
    out (Fst x) = Left x
    out (Next x) = Right x

aux :: T a -> a
aux (Fst x) = x
aux (Next x) = aux x

tmap_lns l = gmap_lns' (aux . snd) snd l

exampleT = put (tmap_lns (fst_lns 'c')) (Fst 1,(Next (Fst (2,'a'))))