From 8c1bd139c029f518e732e6bb94795cf7f0fc4331 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Tue, 5 Apr 2016 00:54:36 +0200
Subject: [PATCH] Readd TH constructors

---
 hpath.cabal  |  1 +
 src/HPath.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/hpath.cabal b/hpath.cabal
index 2024be6..f980bf9 100644
--- a/hpath.cabal
+++ b/hpath.cabal
@@ -21,6 +21,7 @@ library
                    , exceptions
                    , deepseq
                    , word8
+                   , template-haskell
 
 test-suite test
     type: exitcode-stdio-1.0
diff --git a/src/HPath.hs b/src/HPath.hs
index 1d3eb4e..2c8f0c2 100644
--- a/src/HPath.hs
+++ b/src/HPath.hs
@@ -11,6 +11,7 @@
 
 
 
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -32,6 +33,10 @@ module HPath
   ,parseAbs
   ,parseFn
   ,parseRel
+  -- * Path Constructors
+  ,mkAbs
+  ,mkFn
+  ,mkRel
   -- * Path Conversion
   ,canonicalizePath
   ,fromAbs
@@ -93,6 +98,8 @@ import           Foreign.C.String
 import           Foreign.Marshal.Alloc(allocaBytes)
 import           HPath.Foreign
 import           HPath.Internal
+import           Language.Haskell.TH
+
 
 --------------------------------------------------------------------------------
 -- Types
@@ -167,6 +174,39 @@ parseFn filepath =
      else throwM (InvalidFn filepath)
 
 
+
+--------------------------------------------------------------------------------
+-- Constructors
+
+-- | Make a 'Path Abs TPS'.
+--
+-- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@)
+-- may compile on your platform, but it may not compile on another
+-- platform (Windows).
+mkAbs :: ByteString -> Q Exp
+mkAbs s =
+  case parseAbs s of
+    Left err -> error (show err)
+    Right (MkPath str) ->
+      [|MkPath $(return (LitE (StringL (show str)))) :: Path Abs|]
+
+-- | Make a 'Path Rel TPS'.
+mkRel :: ByteString -> Q Exp
+mkRel s =
+  case parseRel s of
+    Left err -> error (show err)
+    Right (MkPath str) ->
+      [|MkPath $(return (LitE (StringL (show str)))) :: Path Rel|]
+
+-- | Make a 'Path Rel TPS'.
+mkFn :: ByteString -> Q Exp
+mkFn s =
+  case parseFn s of
+    Left err -> error (show err)
+    Right (MkPath str) ->
+      [|MkPath $(return (LitE (StringL (show str)))) :: Path Fn|]
+
+
 --------------------------------------------------------------------------------
 -- Path Conversion