{-# LANGUAGE DeriveGeneric #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Putlenses.Examples.People
-- Copyright   :  (C) 2013 Hugo Pacheco
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Hugo Pacheco <hpacheco@nii.ac.jp>
-- Stability   :  provisional
--
-- Database examples for a source database with a list of people.
-- 
--
--
----------------------------------------------------------------------------

module Generics.Putlenses.Examples.People where

import Generics.Putlenses.Language
import Generics.Putlenses.TH
import Generics.Putlenses.Putlens
import Generics.Putlenses.Examples.Examples
import Data.Maybe
import Data.List
import GHC.Generics

type Name = String
type City = String

data Person = Person { name :: Name, city :: City } deriving (Eq,Show,Generic)
$( makePutlensFields ''Person ) -- generates two putlenses namePut and cityPut

nameP :: Putlens st e Person Name
nameP = innPut .< keepsndPut

-- ** DB project

peopleNamesPut0 :: City -> Putlens st e [Person] [Name]
peopleNamesPut0 newc = mapPut (withMbS (innPut .< addsndPut cityOf))
    where cityOf st s v = maybe newc (get cityLns) s

exPeopleNamesPut1 = put (put2lens $ peopleNamesPut0 "Braga") [sebastian,zhenjiang] ["Hugo","Sebastian","Zhenjiang"]

peopleNamesPut :: City -> Putlens st e [Person] [Name]
peopleNamesPut newc = withS (mapPut (innPut .< addsndPut cityOf))
    where cityOf st people n = case find (\p -> get nameLns p == n) people of
	        { Just p -> get cityLns p; Nothing -> newc }

exPeopleNamesPut2 = put (put2lens $ peopleNamesPut "Braga") [sebastian,zhenjiang] ["Hugo","Sebastian","Zhenjiang"]

-- ** DB select

-- | Generic database select putlens
selectPut :: (Eq a,Ord k) => (a -> k) -> (st -> e -> [a]) -> (a -> Bool) -> Putlens st e [a] [a]
selectPut key entries p = initSt (\st m v -> (Nothing,entries st m)) (selectPut' key p)

selectPut' :: (Eq a,Ord k) => (a -> k) -> (a -> Bool) -> Putlens (Maybe a,[a]) e [a] [a]
selectPut' key p = modifySt (\(_,xs) _ vs -> recoverEntry key xs vs) (ifthenelsePut (\(x,_) _ _ -> isJust x) recover it)
    where recover = consPut .< phiPut (not . p . fst) .< (idPut ><< selectPut' key p) .< addfstPut (\(Just x,_) _ _ -> x)
          it = innPut .< (idPut -|-< idPut ><< selectPut' key p) .< outPut

recoverEntry :: Ord k => (a -> k) -> [a] -> [a] -> (Maybe a,[a])
recoverEntry key [] _ = (Nothing,[]) -- empty state
recoverEntry key (x:xs) [] = (Just x,xs) -- when the view is empty
recoverEntry key (x:xs) (v:vs) | key v < key x = (Nothing,x:xs) -- iterate
                               | key v == key x = (Nothing,xs) -- iterate
                               | key v > key x = (Just x,xs) -- recover

nameLns = put2lens namePut
cityLns = put2lens cityPut

isFrom c p = get cityLns p == c

-- | Selects all people @from@ a city
peopleFromPut :: City -> Putlens st [Person] [Person] [Person]
peopleFromPut from = selectPut (get nameLns) (\st -> elsewhere) (isFrom from)
	where elsewhere = filter (not . isFrom from)

-- | Selects all people @from@ a city (moves deleted people to a new city @to@)
peopleFromToPut :: City -> City -> Putlens st [Person] [Person] [Person]
peopleFromToPut from to = selectPut (get nameLns) (\st -> map move) (isFrom from)
	where move p | get cityLns p == from = put cityLns p to
	             | otherwise = p

people = [hugo,sebastian,zhenjiang]
hugo = Person "Hugo" "Tokyo"
sebastian = Person "Sebastian" "Kiel"
zhenjiang = Person "Zhenjiang" "Tokyo"
sebastianTokyo = Person "Sebastian" "Tokyo"

exPeopleFromPut1 = get (put2lens (peopleFromPut "Tokyo")) people
exPeopleFromPut2 = put (put2lens (peopleFromPut "Tokyo")) people [zhenjiang]
exPeopleFromPut3 = put (put2lens (peopleFromPut "Tokyo")) people [sebastianTokyo,zhenjiang]

exPeopleFromToPut1 = put (put2lens (peopleFromToPut "Tokyo" "Braga")) people [zhenjiang]
exPeopleFromToPut2 = put (put2lens (peopleFromToPut "Tokyo" "Braga")) people [sebastianTokyo,zhenjiang]

-- ** DB Join

type Book = (String,String)
type BookPerson = (String,Person)

withM :: (m1 -> Maybe s -> Maybe v -> v -> m2) -> Putlens st m2 s v -> Putlens st m1 s v
withM = undefined

booksOfPeoplePut :: Putlens st ([Book],[Person]) ([Book],[Person]) [BookPerson]
booksOfPeoplePut = paramsndPut (\ps -> withS $ booksOfPut ps) .< booksOfPeoplePut'

booksOfPeoplePut' :: Putlens st e ([Book],[Person]) [BookPerson]
booksOfPeoplePut' = withS $ initSt (\_ s _ -> snd s) $ (innPut ><< idPut) .< undistlPut .< (keepsndOrPut (\st e v -> st) -|-< it) .< outPut
  where it = unforkPut ((keepsndOrPut (\st e -> const []) ><< idPut) .< booksOfPersonPut) ((keepfstPut ><< idPut) .< booksOfPeoplePut')

booksOfPersonPut :: Putlens [Person] e (Book,[Person]) BookPerson
booksOfPersonPut = paramfstPut (\(b,n) -> selectPersonPut n) .< joinBookPersonPut
joinBookPersonPut :: Putlens st e (Book,Person) BookPerson
joinBookPersonPut = assoclPut .< (idPut ><< addfstPut (\_ _ -> get nameLns))

booksOfPeoplePut2 :: Putlens st ([Book],[Person]) ([Book],[Person]) [BookPerson]
booksOfPeoplePut2 = paramsndPut (\ps -> withS $ booksOfPut ps) .< modifyS (\st m (bs,ps) v' -> (bs,peopleWithoutBooks (bs,ps))) booksOfPeoplePut'
  where peopleWithoutBooks (bs,ps) = let bps = get (put2lens booksOfPeoplePut') (bs,ps)
	                                 in filter (\p -> not ((get nameLns p) `elem` (map (get nameLns . snd) bps))) ps

booksOfPut :: [Person] -> Putlens st [Book] [Book] [Book]
booksOfPut ps = selectPut fst (\st -> elsewhere) (isOf ps)
	where elsewhere = filter (not . isOf ps) 
	      isOf ps (b,p) =  p `elem` (map (get nameLns) ps)

selectPersonPut :: Name -> Putlens [Person] e [Person] Person
selectPersonPut n = selectPut (get nameLns) (\st e -> elseone st) (isPerson n) .< wrapPut
	where elseone = filter (not . isPerson n)
	      isPerson n p = get nameLns p == n

someBooks = [("The Art of Computer Programming","Zhenjiang")
            ,("The Elements of Style","Sebastian")
            ,("The Maias","Hugo")
            ,("The Lord of the Rings","Hugo")]
somePeople = [Person "Hugo" "Braga",Person "Zhenjiang" "Tokyo",Person "Tim" "New York"]

someJoin = [("The Art of Computer Programming",Person "Zhenjiang" "Tokyo")
           ,("The Maias",Person "Hugo" "Braga")
           ,("The Lord of the Rings",Person "Hugo" "Braga")]

insMock = [("The Art of Computer Programming",Person "Zhenjiang" "Tokyo")
          ,("The Maias",Person "Hugo" "Braga")
          ,("The Lord of the Rings",Person "Hugo" "Braga")
          ,("To Mock a Mocking Bird",Person "Sebastian" "Kiel")]
-- insert person and delete other books for the same person

exJoinPut1 = put (put2lens booksOfPeoplePut) (someBooks,somePeople) insMock
exJoinPut2 = put (put2lens booksOfPeoplePut2) (someBooks,somePeople) insMock

delLOTR = [("The Art of Computer Programming",Person "Zhenjiang" "Tokyo")
           ,("The Maias",Person "Hugo" "Braga")]
-- delete only book

exJoinPut3 = put (put2lens booksOfPeoplePut) (someBooks,somePeople) delLOTR
exJoinPut4 = put (put2lens booksOfPeoplePut2) (someBooks,somePeople) delLOTR

delLOTRMaias = [("The Art of Computer Programming",Person "Zhenjiang" "Tokyo")]
-- delete both books; delete only books/only person

exJoinPut5 = put (put2lens booksOfPeoplePut) (someBooks,somePeople) delLOTRMaias
exJoinPut6 = put (put2lens booksOfPeoplePut2) (someBooks,somePeople) delLOTRMaias