From d0c5d0698ed73d87050fe6a46fa42a85e967e08a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= <fhi.1990@gmail.com>
Date: Sat, 2 Feb 2019 17:53:43 +0100
Subject: [PATCH] Change install script to Haskell

---
 install.hs | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 install.sh | 17 -------------
 2 files changed, 72 insertions(+), 17 deletions(-)
 create mode 100755 install.hs
 delete mode 100644 install.sh

diff --git a/install.hs b/install.hs
new file mode 100755
index 0000000..4463191
--- /dev/null
+++ b/install.hs
@@ -0,0 +1,72 @@
+#!/usr/bin/env runhaskell
+{-# Language GADTSyntax, LambdaCase #-}
+{-# OPTIONS_GHC -Wall #-}
+
+import Data.Foldable (traverse_)
+import Data.Functor (void)
+import GHC.IO.Handle (Handle)
+import System.Process (createProcess, proc, ProcessHandle)
+import System.Environment
+import System.FilePath
+
+symlink
+  :: FilePath
+  -> FilePath
+  -> Link
+  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
+symlink dotfiles config s
+  = createProcess (proc "ln" ["-s", source, target])
+  where
+  (source, target) = spec s
+  spec :: Link -> (FilePath, FilePath)
+  spec = \case
+    Config p         -> (dotfiles </> p, config)
+    Absolute trg src -> (trg, src)
+
+getHome :: IO FilePath
+getHome = getEnv "HOME"
+
+-- TODO Make configurable/more portable.
+getDotfiles :: FilePath -> FilePath
+getDotfiles home = home </> "git/fredefox/dotfiles"
+
+getConfig :: FilePath -> FilePath
+getConfig home = home </> ".config"
+
+
+data Link where
+  Config :: FilePath -> Link
+  Absolute :: FilePath -> FilePath -> Link
+
+getLinks :: FilePath -> [] Link
+getLinks home = std <> absolute
+  where
+  std = Config <$>
+    [ "git"
+    , "i3"
+    , "urxvt"
+    , "xinit"
+    , "Xresources"
+    , "zsh"
+    ]
+  absolute =
+    [ ".emacs.d"    |> ".config/emacs"
+    , ".gitconfig"  |> ".config/git/config"
+    , ".urxvt"      |> ".config/urxvt"
+    , ".xinitrc"    |> ".config/xinit/xinitrc"
+    , ".xsession"   |> ".xinitrc"
+    , ".xsessionrc" |> ".config/xinit/xinitrc"
+    , ".zshrc"      |> ".config/zsh/init"
+    ]
+  src |> trg = Absolute trg (home </> src)
+
+main :: IO ()
+main = do
+  home <- getHome
+  let
+    config   = getConfig home
+    dotfiles = getDotfiles home
+    links    = getLinks home
+  void $ createProcess (proc "mkdir" [config])
+  traverse_ (symlink dotfiles config) links
+
diff --git a/install.sh b/install.sh
deleted file mode 100644
index 2ebc160..0000000
--- a/install.sh
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/usr/bin/bash
-# Untested!!
-
-ln -s ~/.emacs.d ~/.conf/emacs
-
-tee ~/.xinitrc << EOF
-#!/usr/bin/env bash
-
-setxkbmap -option grp:win_space_toggle -layout us,dk
-xrdb -merge ~/.Xresources
-EOF
-
-tee ~/.Xresources << EOF
-#include ".config/Xresources/general"
-#include ".config/Xresources/urxvt"
-#include ".config/Xresources/theme/monokai-dark
-EOF