-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Pointless.Lenses.Examples.MapExamples
-- Copyright   :  (c) 2010 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Lenses:
-- bidirectional lenses with point-free programming
-- 
-- More example involving composed maps.
--
-----------------------------------------------------------------------------

module Generics.Pointless.Lenses.Examples.MapExamples where

import Generics.Pointless.Functors
import Generics.Pointless.Combinators
import Generics.Pointless.Lenses
import Generics.Pointless.Lenses.Combinators
import Generics.Pointless.Lenses.Examples.Recs
import Generics.Pointless.Lenses.Examples.Examples

-- ** map ! . filter_left . map (map f -|- map g)

mapbang_hand :: Lens [Either [(Int,Char)] [(Bool,Char)]] [One]
mapbang_hand = Lens get' put' create'
    where
    get' [] = []
    get' (Left _ :xs) = _L : get' xs
    get' (Right _:xs) = get' xs
    create' [] = []
    create' (x:xs) = Left [] : create' xs
    put' ([],[]) = []
    put' (l,Right y:ys) = Right y : put' (l,ys)
    put' ([],_) = []
    put' (x:xs,Left y:ys) = Left y : put' (xs,ys)
    put' (x:xs,[]) = Left [] : put' (xs,[])

mapbang_pf :: Lens [Either [(Int,Char)] [(Bool,Char)]] [One]
mapbang_pf = map_pf ((!<) (innList . inl . bang)) .< filter_left_pf
     .< map_pf (map_pf (fst_lns (pnt 'c' . bang)) -|-< map_pf (snd_lns (pnt True . bang)))
 
mapbang_opt :: Lens [Either [(Int,Char)] [(Bool,Char)]] [One]   
mapbang_opt = cataList_lns (((\/<) (inl . bang) f g) .< coassocl_lns .< (id_lns -|-< distl_lns))
    where f = innList_lns .< (id_lns -|-< (((!<) (innList . inl)) ><< id_lns))
          g = snd_lns _L
          
-- ** Persons (count the number of women)

type Person = (Name,Gender)
type Name = String
data Gender = M | F deriving (Eq,Show,Read)

innGender :: Either One One -> Gender
innGender = const M \/ const F

outGender :: Gender -> Either One One
outGender M = Left _L
outGender F = Right _L

outGender_lns :: Lens Gender (Either One One)
outGender_lns = Lens outGender (innGender . fst) innGender

type instance PF Gender = Const One :+: Const One
instance Mu Gender where
    inn (Left _) = M
    inn (Right _) = F
    out M = Left _L
    out F = Right _L

women_hand :: Lens [Person] Nat
women_hand = Lens get' put' create'
    where
    get' [] = nzero
    get' ((nm,M):ps) = get' ps
    get' ((nm,F):ps) = nsucc (get' ps)
    create' (Nat 0) = []
    create' (Nat (pred -> n)) = ("woman",F) : create' (Nat n)
    put' (Nat 0,[]) = []
    put' (n,(nm,M):ps) = (nm,M) : put' (n,ps)
    put' (Nat 0,(nm,F):ps) = put' (Nat 0,ps)
    put' (Nat (pred -> n),[]) = ("woman",F) : create' (Nat n)
    put' (Nat (pred -> n),(nm,F):ps) = (nm,F) : put' (Nat n,ps)

women_pf :: Lens [Person] Nat
women_pf = length_lns _L .< filter_right_pf .< map_pf (outGender_lns .< snd_lns (pnt "woman" . bang))
    
women_opt :: Lens [Person] Nat
women_opt = cataList_lns ((innNat_lns .< (id_lns -|-< snd_lns bang) .\/< snd_lns bang) .< f)
    where f = coassocl_lns
           .< (id_lns -|-< (coswap_lns .< distl_lns .< (g ><< id_lns)))
          g = outGender_lns .< snd_lns (pnt "woman" . bang)