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))

-- | Binary list concatenation.
cat_lns :: Lens ([a],[a]) [a]
cat_lns = Lens get' put' create'
    where get' = uncurry (++)
          put' (l,(e,d)) = splitAt (length e) l
          create' l = splitAt (length l `div` 2) l

data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Eq,Show)

type instance BF Tree = BConst One :+| (BPar :*| (BId :*| BId))

type instance PF (Tree a) = Const One :+: (Const a :*: (Id :*: Id))

instance Mu (Tree a) where
   inn (Left _) = Empty
   inn (Right (a,(b,c))) = Node a b c
   out Empty = Left _L
   out (Node a b c) = Right (a,(b,c))

-- | Flatten a tree.
flatten_lns :: Lens (Tree a) [a]
flatten_lns = cata_lns _L (inn_lns .< (id_lns -|-< id_lns ><< cat_lns))

-- | List concatenation.
concat_lns :: Lens [[a]] [a]
concat_lns = cata_lns _L (inn_lns .< (((id_lns .\/< id_lns) -|-< id_lns) .< coassocl_lns .< (id_lns -|-< out_lns .< cat_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'))))