packages feed

pointless-rewrite-0.0.3: src/Transform/Examples/Imdb.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Transform.Examples.Imdb
-- Copyright   :  (c) 2010 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Rewrite:
-- automatic transformation system for point-free programs
-- 
-- Imdb lens example
--
-----------------------------------------------------------------------------

module Transform.Examples.Imdb where

import Data.Type
import Data.Pf
import Data.Lens
import Transform.Rewriting
import Transform.Rules.Lenses
import Transform.Rules.PF

import Generics.Pointless.Functors
import Generics.Pointless.Lenses
import Generics.Pointless.Lenses.Examples.Imdb hiding (imdb,imdb_opt,movie,reviews,actor,shows,boxoffices,awards)

import Prelude hiding (Show(..),concat,length,shows)

-- ** Specifications

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

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

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

awards :: Pf (Lens [Played] [Category])
awards = MAP_LNS (SND_LNS (VAR "dyear")) .<< CONCAT_LNS .<< MAP_LNS (SND_LNS (VAR "dytrole"))

shows :: Pf (Lens [Show] [(((Year,Title),Nat),(Director,Value))])
shows = COMP_LNS t (MAP_LNS f) $ COMP_LNS t' FILTER_LEFT_LNS $ MAP_LNS DISTR_LNS .<< MAP_LNS g
    where f = (ID_LNS ><<< VAR "reviews") ><<< ID_LNS
          g = ID_LNS ><<< (VAR "movie" -|-<< VAR "tv")
          t = typeof
          t' = typeof :: Type [Either (((Year,Title),[Review]),(Director,Value)) (((Year,Title),[Review]),TV)]

boxoffices :: Pf (Lens [BoxOffice] Value)
boxoffices = SUMN_LNS .<< FILTER_RIGHT_LNS .<< MAP_LNS (OUT_LNS .<< SND_LNS (VAR "dcountry"))

reviews :: Pf (Lens [Review] Nat)
reviews = LENGTH_LNS "ccomment" .<< CONCAT_LNS .<< MAP_LNS (SND_LNS (VAR "duser"))

-- ** Optimization

imdb_opt = reduceIO optimise_lns typeof imdb

imdbput_opt = imdb_opt >>= reduceIO optimise_pf typeof . putof typeof