-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Pointless.Lenses.Examples.Imdb
-- 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
-- 
-- Internet Movie Database example
--
-----------------------------------------------------------------------------

module Generics.Pointless.Lenses.Examples.Imdb where
    
import Prelude hiding (Show(..),concat,length,shows)
import Generics.Pointless.Functors (Nat(..))
import Generics.Pointless.Combinators
import Generics.Pointless.Lenses.Combinators
import Generics.Pointless.Lenses
import Generics.Pointless.Lenses.Examples.Recs
import Generics.Pointless.Lenses.Examples.Examples
    
type Imdb = ([Show],[Actor])
type Show = (((Year,Title),[Review]),Either Movie TV)
type Review = (User,[Comment])
type Movie = (Director,[BoxOffice])
type BoxOffice = (Country,Maybe Value)
type TV = [Season]
type Season = (Year,[Episode])
type Actor = (Name,[Played])
type Played = (((Year,Title),Role),[Award])
type Award = (Year,Category)

type Year = Int
type Title = String
type User = String
type Comment = String
type Director = String
type Country = String
type Value = Nat
type Episode = String
type Name = String
type Role = String
type Category = String

dyear = const 2010
dtitle = const "unknown"
dlist = const []
drole = const "unknown"
dcountry = const "unknown"
duser = const "anonymous"
dcomment = "empty"
dytrole :: x -> ((Year,Title),Role)
dytrole = (dyear /\ dtitle) /\ drole

-- ** Specification

imdb :: (Lens Imdb ([(((Year,Title),Nat),(Director,Value))],[(Name,[Category])]))
imdb = (shows ><< map_pf actor)

actor :: (Lens Actor (Name,[Category]))
actor = id_lns ><< awards

movie :: (Lens Movie (Director,Value))
movie = id_lns ><< boxoffices

awards :: Lens [Played] [Category]
awards = map_pf (snd_lns dyear) .< concat_pf .< map_pf (snd_lns dytrole)

shows :: (Lens [Show] [(((Year,Title),Nat),(Director,Value))])
shows = (map_pf f) .< filter_left_pf .< map_pf distr_lns .< map_pf g
    where f = (id_lns ><< reviews) ><< id_lns
          g = id_lns ><< (movie -|-< tv)
          
boxoffices :: (Lens [BoxOffice] Value)
boxoffices = sumn_lns .< filter_right_pf .< map_pf (outMaybe_lns .< snd_lns dcountry)

reviews :: (Lens [Review] Nat)
reviews = length_lns dcomment .< concat_pf .< map_pf (snd_lns duser)

tv :: Lens TV [Episode]
tv = concat_pf .< map_pf (snd_lns dyear)

-- ** Optimization

imdb_opt :: (Lens Imdb ([(((Year,Title),Nat),(Director,Value))],[(Name,[Category])]))
imdb_opt = (shows_opt><< map_pf actor_opt)

actor_opt :: (Lens Actor (Name,[Category]))
actor_opt = id_lns ><< awards_opt

movie_opt :: (Lens Movie (Director,Value))
movie_opt = id_lns ><< boxoffices_opt

awards_opt :: Lens [Played] [Category]
awards_opt = cataList_lns $ innList_lns .< f .< coassocl_lns .< (id_lns -|-< outList_lns .< hyloNeList_lns g h .< ((snd_lns dytrole) ><< id_lns))
    where
    f = (!<) inl -|-< id_lns
    g = innList_lns .< (id_lns -|-< (((inr . bang) \/< id_lns) id_lns)) .< coassocr_lns
    h = ((outList_lns .< (snd_lns bang)) -|-< (assocr_lns .< (((snd_lns dyear) ><< id_lns) ><< id_lns)))
      .< distl_lns .< (outList_lns ><< id_lns)

shows_opt :: (Lens [Show] [(((Year,Title),Nat),(Director,Value))])    
shows_opt = cataList_lns aux
    where
    aux = ((\/<) (inl . bang) l r) .< f
    l = innList_lns .< (id_lns -|-< ((((id_lns ><< reviews) ><< movie) .< swap_lns) ><< id_lns))
    r = snd_lns _L
    f = coassocl_lns .< (id_lns -|-< (distl_lns .< ((distl_lns .< swap_lns) ><< id_lns)))

boxoffices_opt :: (Lens [BoxOffice] Value)
boxoffices_opt = cataList_lns aux
    where
    aux = ((\/<) (inl . bang) l r) .< coassocl_lns .< f
    l = innNat_lns .< (((!<) inl) -|-< id_lns) .< coassocl_lns .< (id_lns -|-< (outNat_lns .< plus_lns))
    r = snd_lns bang
    f = (id_lns -|-< (coswap_lns .< distl_lns .< ((outMaybe_lns .< (snd_lns dcountry)) ><< id_lns)))

reviews_opt :: (Lens [Review] Nat)
reviews_opt = cataList_lns aux
    where
    aux = innNat_lns .< (((!<) inl) -|-< id_lns) .< coassocl_lns .< (id_lns -|-< outNat_lns .< f)
    f = hyloNeNat_lns g h .< ((snd_lns duser) ><< id_lns)
    g = innNat_lns .< (id_lns -|-< (((inr . bang) \/< id_lns) id_lns)) .< coassocr_lns
    h = ((outNat_lns .< (snd_lns bang)) -|-< ((snd_lns (const dcomment)) ><< id_lns)) .< distl_lns .< (outList_lns ><< id_lns)