6 files changed, 237 insertions, 1 deletions

diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..a292d0f
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "ws2015/ffp/presentation/thermoprint.git"]
+        path = ws2015/ffp/presentation/thermoprint.git
+        url = git:thermoprint
diff --git a/shell.nix b/shell.nix
index 099d567..a121ec4 100644
--- a/shell.nix
+++ b/shell.nix
@@ -14,7 +14,7 @@ pkgs.stdenv.mkDerivation rec {
                     with p; [ yesod yesod-bin pandoc monad-par persistent-sqlite
                             ]))
                   (pkgs.texlive.combine {
-                    inherit (pkgs.texlive) scheme-small libertine tipa cm-super context bussproofs mweights fontaxes backnaur enumitem;
+                    inherit (pkgs.texlive) scheme-small libertine tipa cm-super context bussproofs mweights fontaxes backnaur enumitem varwidth beamer;
                   })
                 ];
   shellHook = ''
diff --git a/ws2015/ffp/presentation/presentation.pdf.gup b/ws2015/ffp/presentation/presentation.pdf.gup
new file mode 100644
index 0000000..b609189
--- /dev/null
+++ b/ws2015/ffp/presentation/presentation.pdf.gup
@@ -0,0 +1,8 @@
+#!/usr/bin/env zsh
+
+gup -u ${2%.pdf}.tex
+
+for i in $(seq 0 1); do
+    lualatex ${2%.pdf}.tex
+done
+[[ -e "$2" ]] && touch "$2"
diff --git a/ws2015/ffp/presentation/presentation.tex b/ws2015/ffp/presentation/presentation.tex
new file mode 100644
index 0000000..7370361
--- /dev/null
+++ b/ws2015/ffp/presentation/presentation.tex
@@ -0,0 +1,189 @@
+\documentclass{beamer}
+\usepackage{pgfpages}
+
+\title[Thermoprint]{Thermoprint -- A Toolset for Interacting With Character Based Printers}
+\subtitle[]{A project in advanced functional programming}
+\author{Gregor Kleen}
+\date{WiSe 2015--16}
+
+\beamertemplatenavigationsymbolsempty
+\usetheme{Montpellier}
+\usecolortheme{dove}
+
+\setbeameroption{show notes on second screen}
+
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage[tt=false]{libertine}
+
+\usepackage{tikz}
+\usetikzlibrary{positioning,shapes}
+
+\usepackage{varwidth}
+\newsavebox\IBox
+\newenvironment{resizefig}[1][\textwidth]{\gdef\figWidth{#1}\begin{lrbox}{\IBox}\varwidth{\textwidth}\centering}{\endvarwidth\end{lrbox}\resizebox{\figWidth}{!}{\usebox\IBox}}
+
+\usepackage{listings}
+\lstset{language=Haskell}
+\lstset{basicstyle=\ttfamily,breaklines=true,postbreak=\raisebox{0ex}[0ex][0ex]{\ensuremath{\color{gray}\hookrightarrow\space}}}
+
+\begin{document}
+\frame{\titlepage}
+\frame{\tableofcontents}
+
+\section{Motivation}
+
+\begin{frame}
+  \frametitle{How to Talk to a Line Thermal Printer}
+  \begin{description}
+  \item[\texttt{ESC/POS}]
+    \begin{itemize}
+    \item An industry standard
+    \item Control-\alert{bytes}
+    \end{itemize}
+  \end{description}
+  \emph{Preparing printouts manually is ridiculous.}\\
+  Therefore: \alert{semantic} document format
+\end{frame}
+
+\section{Project Structure}
+
+\begin{frame}
+  \begin{figure}
+    \begin{resizefig}[0.8\textwidth]
+      \begin{tikzpicture}[node distance=4cm]
+        \tikzstyle{package} = [rectangle, draw=black!80]
+        \node[package] (spec) [] {thermoprint-spec};
+        \node[package] (tprint) [below of=spec] {tprint};
+        \node[package] (client) [right of=tprint] {thermoprint-client};
+        \node[package] (webgui) [below of=tprint] {thermoprint-webgui};
+        \node[package] (tp-bbcode) [left of=tprint] {thermoprint-bbcode};
+        \node[package] (bbcode) [above of=tp-bbcode] {bbcode};
+        \node[package] (server) [right of=spec] {thermoprint-server};
+        \draw[->] (client) to (spec);
+        \draw[->] (tprint) to (client);
+        \draw[->] (webgui) to (client);
+        \draw[->] (tprint) to (tp-bbcode);
+        \draw[->] (webgui) to (tp-bbcode);
+        \draw[->] (tp-bbcode) to (bbcode);
+        \draw[->] (tp-bbcode) to (spec);
+        \draw[->] (server) to (spec);
+        \draw[->, dashed] (server) -- (client);
+      \end{tikzpicture}
+      \label{fig:cabal_dep_graph}
+      \caption{Dependency graph}
+    \end{resizefig}
+  \end{figure}
+
+  \note[item]{\texttt{theromprint-spec}: defines API \& document format}
+  \note[item]{\texttt{bbcode}: parser for bbcode}
+  \note[item]{\texttt{tp-bbcode}: parses bbcode Document Object Model to document format}
+  \note[item]{\texttt{client}: derivation of client for API defined in \texttt{thermoprint-spec}}
+  \note[item]{\texttt{server}: implementation of server for API defined in \texttt{thermoprint-spec} (mostly database Create Read Update \& Delete)}
+  \note[item]{\texttt{webgui}: uses \texttt{tp-bbcode}, \texttt{client} and (a patched version of) \texttt{threepenny}}
+  \note[item]{\texttt{tprint}: uses \texttt{tp-bbcode}, \texttt{client} and \texttt{optparse-applicative}}
+  \note[item]{\texttt{server} uses \texttt{client} only for testing (also covers \texttt{client})}
+\end{frame}
+
+\section{An Introduction to Servant}
+
+\begin{frame}[fragile]
+  \frametitle{An API}
+  \begin{lstlisting}
+      -- GET /date
+type MyAPI = "date" :> Get '[JSON] Date
+      -- GET /time/:tz
+        :<|> "time"
+          :> Capture "tz" Timezone
+          :> Get '[JSON] Time
+
+myAPI :: Proxy MyAPI
+myAPI = Proxy      
+  \end{lstlisting}
+
+  \note[item]{\texttt{:<|>} combines two alternative apis into one (isomorphic to \texttt{(,)})}
+  \note[item]{\texttt{:>} composes parts of url: literals (\texttt{-XOverloadedStrings}), captures, query arguments, endpoints\\also isomorphic to \texttt{(,)} -- binds stronger than \texttt{:<|>}}
+  \note[item]{\texttt{'[JSON]} is a type of the kind \texttt{[JSON]} -- acceptable encodings carried within the type (\texttt{-XDataKinds})}
+\end{frame}
+
+\begin{frame}[fragile]
+  \frametitle{A Server}
+  \begin{lstlisting}
+server :: Server MyAPI
+server = getDate :<|> getTimeForTZ
+  where
+    getDate :: EitherT ServantErr IO Date
+    getDate = liftIO getCurrentDate
+    getTimeForTZ :: Timezone
+                 -> EitherT ServantErr IO Time
+    getTimeForTZ = liftIO . getTimeAtTZ
+
+main :: IO ()
+main = run 8000 $ serve myAPI server
+
+serve :: HasServer layout => Proxy layout -> Server layout -> Application
+  \end{lstlisting}
+
+  \note[item]{\texttt{Application} \& \texttt{run} from wai and warp}
+  \note[item]{\texttt{HasServer} maps api type to handler type via associated type family \& recursion}
+  \note[item]{servant provides utilities for changing monad -- \texttt{:<|>} is associative under (effectively) monad functors}
+\end{frame}
+
+\begin{frame}[fragile]
+  \frametitle{A Client}
+  \begin{lstlisting}
+getCurrentDate :: EitherT ServantError IO Date
+getTimeAtTZ :: Timezone
+            -> EitherT ServantError IO Time
+(getCurrentDate :<|> getTimeAtTZ) = client myAPI url
+  where url = BaseUrl Http "localhost" 8000
+
+client :: HasClient layout
+       => Proxy layout
+       -> BaseUrl
+       -> Client layout
+  \end{lstlisting}
+
+  \note[item]{\texttt{Client} is associated type family of \texttt{HasClient}}
+  \note[item]{\texttt{:<|>} on left side of \texttt{=} is pattern match}
+\end{frame}
+
+\section{On the Difficulties Existentially Quantified Configuration Introduces}
+
+\begin{frame}[fragile]
+  \frametitle{Thermoprints Use of Existential Quantification}
+  \begin{lstlisting}
+type QueueManager t = StateT Queue t STM ()
+  -- Not really
+
+intersection :: [QueueManager t] -> QueueManager t
+idQM :: QueueManager t
+
+data QMConfig m where
+  QMConfig :: (MonadTrans t, …) => QueueManager t -> (t IO) :~> m -> QMConfig m
+  \end{lstlisting}
+
+  \pause
+  Can we build \texttt{intersection} and \texttt{idQM} for \texttt{QMConfig}?
+
+  \note[item]<1>{\texttt{QueueManager}s manage queues.}
+  \note[item]<1>{\texttt{QMConfig} makes configuration nicer for the user (methinks)}
+  \note[item]<1>{\texttt{:$\sim$>} means monad functor in servant-speak}
+
+  \note[item]<2>{Combining \texttt{QueueManager}s is obviously useful. Why not \texttt{QMConfig}s?}
+\end{frame}
+
+\begin{frame}[fragile]
+  \frametitle{Difficulty in combining \texttt{QMConfig}s}
+  \begin{lstlisting}
+combineMgrs :: Monad (t (t' IO)) => QueueManager t -> QueueManager t' -> QueueManager (ComposeT t t')
+
+combine :: {-# constraints #-} QMConfig m -> QMConfig m -> QMConfig m
+  \end{lstlisting}
+  \note[item]{\texttt{QMConfig} carries constraints -- we need them for the result}
+  \note[item]{\texttt{QMConfig} carries no information about its transformer in its type}
+  \note[item]{Therefore we cannot construct a constraint for \texttt{combine}}
+  \note[item]{We \emph{might} be able to have \texttt{QMConfig} carry the necessary constraints for \texttt{combine} but thats difficult.\\Might be possible with quantified constraints (available on hackage), but not easily -- no partially applied types in haskell}
+\end{frame}
+
+\end{document}
diff --git a/ws2015/ffp/presentation/shell.nix b/ws2015/ffp/presentation/shell.nix
new file mode 100644
index 0000000..283ab0e
--- /dev/null
+++ b/ws2015/ffp/presentation/shell.nix
@@ -0,0 +1,36 @@
+{ pkgs ? (import <nixpkgs> {})
+, haskellPackages ? (import ./thermoprint.git/default.nix {}).haskellPackages
+}:
+
+let
+  thermoprintPackages = builtins.attrValues (import ./thermoprint.git/default.nix {});
+  ghc = haskellPackages.ghcWithPackages
+    (ps: thermoprintPackages ++ utilities ps ++ testDeps ps);
+  utilities = (ps: with ps; [ ]);
+  testDeps = (ps: with ps; [ ]);
+  shell = pkgs.stdenv.mkDerivation {
+    name = "shell";
+    src = builtins.toFile "shell.sh" ''
+      #!/usr/bin/env zsh
+
+      typeset -a args
+      args=($@)
+      [[ $#@ -eq 0 ]] && args=("-e" "tmux")
+
+      exec urxvtc -bg white -fg black -fn "xft:DejaVu Sans Mono:pixelsize=20" $args
+    '';
+    phases = ["installPhase"];
+    installPhase = ''
+      mkdir -p $out/bin
+      install -m 555 $src $out/bin/shell
+    '';
+  };
+in
+pkgs.stdenv.mkDerivation rec {
+  name = "presentation-env";
+  buildInputs = [ shell ghc ] ++ (with pkgs; [ pdfpc screen-message ]);
+  shellHook = ''
+    eval $(egrep ^export ${ghc}/bin/ghc)
+    export PROMPT_INFO="${name}"
+  '';
+}
diff --git a/ws2015/ffp/presentation/thermoprint.git b/ws2015/ffp/presentation/thermoprint.git
new file mode 160000
+Subproject 5f433ad64700907de155ed1e5155193f28f9357