-- Fortgeschrittene Funktionale Programmierung,
--   LMU, TCS, Wintersemester 2015/16
--   Steffen Jost, Alexander Isenko
--
-- Übungsblatt 12. 20.01.2016
--
-- Thema: Database.Persist & Yesod.Persist
--
-- Anweisung: 
--   Bearbeiten Sie ggf. zuerst noch A11-3 und A11-4,
--   falls Sie diese noch nicht bearbeitet haben!
-- 
--   Gehen Sie diese Datei durch und bearbeiten Sie 
--   alle Vorkommen von undefined bzw. die mit -- !!! TODO !!!
--   markierten Stellen. Testen Sie Ihre Lösungen mit GHCi!
--

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}


import qualified Data.Text as T
import Data.Time.Clock    (getCurrentTime)
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import System.Environment (getArgs)
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.Trans.Resource (ResourceT)

import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class

import Text.Read (readMaybe)

-- Nur für A11-2 benötigt:
import Language.Haskell.TH


-- A11-1
--
-- Erstellen Sie mit Database.Persist ein simples Kommandozeilen-Tool
-- zum Zugriff auf eine Datenbank zur Verwaltung von Hausaufgaben.
-- Es soll immer auf die Datenbank im gleichen Verzeichnis zugegriffen werden.
--
-- Es gibt 3 Mögliche Verwendungsarten des Tools:
--
-- 1) > tool <name> <matrikel> <nr> <abgabe>
--
--    Legt eine Abgabe <abgabe> für Übung <nr>
--    von Student <name> mit Matrikelnummer <matrikel>
--    in der Datenbank ab.
--    Ist der Student unbekannt, so wird er angelegt.
--    Die Kombination aus Name und Matrikelnummer muss einzigartig sein.
--
-- 2) > tool <nr>
--
--    Zeigt alle Abgaben zur Übung <nr> auf dem Bildschrim an.
--    Zu jeder Abgabe wird auch der abgebende Student aufgeführt.
--
-- 3) > tool <name>
--
--    Zeigt alle Studenten mit diesem Namen an,
--    so wie jeweils die Anzahl der im System gespeicherten Abgaben
--    zu allen Übungen.
--
-- Ein Demo folgt weiter unten.

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Student
  name String
  matrikel Int
  UniqueStudent name matrikel
Abgabe
  erstellerId StudentId
  ubung Int
  abgabe String
|]

sqliteDB = "demo.sqlite"

type SQLite a = SqlPersistT (NoLoggingT (ResourceT IO)) a

main :: IO ()
main = runSqlite sqliteDB $ do
  liftIO $ putStrLn "Hallo zu HuniworX!"

  runMigration migrateAll

  liftIO getArgs >>= action

action :: [String] -> SQLite ()
action [(readMaybe -> Just ubungsNr)] = mapM_ listAbgabe =<< selectList [AbgabeUbung ==. ubungsNr] []

action [name] = mapM_ listAbgabenCount =<< selectList [StudentName ==. name] []

action [name, (readMaybe -> Just matrikel), (readMaybe -> Just ubungsNr), abgabe] = do
  ersteller <- getBy $ UniqueStudent name matrikel
  erstellerId <- case ersteller of
    Just (Entity id _) -> return id
    Nothing            -> insert $ Student name matrikel
  insert $ Abgabe erstellerId ubungsNr abgabe
  liftIO . putStrLn $ "Abgabe von " ++ name ++ " für Übung " ++ (show ubungsNr) ++ " angenommen"

action _ = liftIO . putStr . unlines $ [ "Optionen sind:"
                                       , " 1) Studentenname"
                                       , " 2) Übungsnummer"
                                       , " 3) Studentenname, Matrikel, Übungsnr, Abgabe"
                                       , "Optionen 1 & 2 sind Abfragen; 3 ist Eingabe"
                                       ]

listAbgabe :: Entity Abgabe -> SQLite ()
listAbgabe (Entity _ (Abgabe erstellerId ubung abgabe)) = do
  (Just (Student name matrikel)) <- get $ erstellerId -- If the database is inconsistent we simply crash since I couldn't be bothered to fail more gracefully
  liftIO . putStrLn $ "----\n" ++ name ++ " " ++ show matrikel ++ " für Übung " ++ show ubung
  liftIO . mapM_ (putStrLn . ("\t" ++)) . lines $ abgabe

listAbgabenCount :: Entity Student -> SQLite ()
listAbgabenCount (Entity studentId (Student name matrikel)) = do
  abgabenCount <- length <$> selectList [AbgabeErstellerId ==. studentId] []
  liftIO . putStrLn $ name ++ " " ++ show matrikel ++ " Abgaben: " ++ show abgabenCount


-- Just use Text.Read.readMaybe
-- maybeRead :: Read a => String -> Maybe a
-- maybeRead (reads -> [(x,"")]) = Just x
-- maybeRead _ = Nothing

-- maybeToInt :: String -> Maybe Int
-- maybeToInt = maybeRead


{- DEMO:

> ./FFP_U11_Persist Steffen 1234 1 "Etwas gemacht"
Hallo zu HuniworX!
Migrating: CREATE TABLE "student"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"matrikel" INTEGER NOT NULL,CONSTRAINT "unique_student" UNIQUE ("name","matrikel"))
Migrating: CREATE TABLE "abgabe"("id" INTEGER PRIMARY KEY,"ersteller_id" INTEGER NOT NULL REFERENCES "student","ubung" INTEGER NOT NULL,"abgabe" VARCHAR NOT NULL)
Abgabe von Steffen für Übung 1 angenommen.
> ./FFP_U11_Persist Steffen 6666 1 "Nix gemacht"
Hallo zu HuniworX!
Abgabe von Steffen für Übung 1 angenommen.
> ./FFP_U11_Persist Steffen 6666 2 "Fast nix gemacht"
Hallo zu HuniworX!
Abgabe von Steffen für Übung 2 angenommen.
> ./FFP_U11_Persist Steffen 1234 2 "Schön gemacht."
Hallo zu HuniworX!
Abgabe von Steffen für Übung 2 angenommen.
> ./FFP_U11_Persist Hilde 9999 2 "Vorbildlich gemacht."
Hallo zu HuniworX!
Abgabe von Hilde für Übung 2 angenommen.
> ./FFP_U11_Persist Steffen 1234 3 "Gut gemacht."
Hallo zu HuniworX!
Abgabe von Steffen für Übung 3 angenommen.
> ./FFP_U11_Persist Steffen
Hallo zu HuniworX!
Steffen 1234 Abgaben: 3
Steffen 6666 Abgaben: 2
> ./FFP_U11_Persist 2
Hallo zu HuniworX!
----
Steffen 6666 für Übung 2
    Fast nix gemacht
----
Steffen 1234 für Übung 2
    Schön gemacht.
----
Hilde 9999 für Übung 2
    Vorbildlich gemacht.
> ./FFP_U11_Persist 1
Hallo zu HuniworX!
----
Steffen 1234 für Übung 1
    Etwas gemacht
----
Steffen 6666 für Übung 1
    Nix gemacht
> ./FFP_U11_Persist Fuu 1
Hallo zu HuniworX!
Optionen sind:
 1) Studentenname
 2) Übungsnummer
 3) Studentenname, Matrikel, Übungsnr, Abgabe
Optionen 1 & 2 sind Abfragen; 3 ist Eingabe
>
-}




-- A11-2 TemplateHaskell
--
-- Hier ist etwas zum Knobeln oder Ausprobieren!
-- Was machen die folgenden TemplateHaskell Funktionen?
-- (zum Ausführen in ghci die Option -XTemplateHaskell nicht vergessen)
--

-- a) Extract ith member of n-tuple
foobar :: Int -> Int -> ExpQ
foobar n i = lamE [pat] rhs
  where pat = tupP (map varP xs)
        rhs = varE (xs !! (i - 1))
        xs  = [ mkName $ "x" ++ show j | j <- [1..n] ]


-- b) Convert list of length ≥ n to n-tuple
barfoo :: Int -> ExpQ
barfoo n = do
    ns <- replicateM n (newName "x")
    lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns)


-- c) @$(fuubaz n m) f@ is a m-ary function on n-tuples returning an n-tuple whose ith component is the result of applying the m-ary function f to the ith components of the codomain
-- It's the curried variant of transposition on tuples followed by pointwise application of an uncurried variant of f
fuubaz:: Int -> Int -> ExpQ
fuubaz n m = do
  let f       = mkName "f"
  let v i j   = mkName $ "x" ++ (show i) ++ (show j)
  let tupleps = [tupP [varP (v i j) | j <- [1..n]] | i <- [1..m] ]
  let args    = [(foldl appE (varE f) [varE $ v i j | i <- [1..m]]) | j <- [1..n]]
  lamE ((varP f):tupleps) (tupE args)