summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormaerwald <>2020-01-13 23:22:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-01-13 23:22:00 (GMT)
commit8e865ce51c81cd2e652fafa9063f9efc181dba5b (patch)
treeaa6ec98c6e5b9f6002c18c791fbfb74b55d69270
parent9c050f1c29bce532fb09ad08535958bdd40ecebb (diff)
version 0.10.10.10.1
-rwxr-xr-xCHANGELOG4
-rwxr-xr-xREADME.md3
-rw-r--r--hpath.cabal4
-rw-r--r--src/HPath.hs71
4 files changed, 80 insertions, 2 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 6f16f61..f5a2fe7 100755
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,7 @@
+0.10.1
+ * Add quasi quoters for hpath
+0.10.0
+ * split packages, this one now just contains the type-safe Path wrappers
0.9.2
* fix build with ghc-7.6
* raise required bytestring version
diff --git a/README.md b/README.md
index 1dd180b..a2bb792 100755
--- a/README.md
+++ b/README.md
@@ -4,6 +4,8 @@
Support for well-typed paths in Haskell.
+This package is part of the HPath suite, also check out [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath) and [hpath-io](https://hackage.haskell.org/package/hpath-io).
+
## Motivation
The motivation came during development of
@@ -34,4 +36,3 @@ Note: this library was written for __posix__ systems and it will probably not su
* allows pattern matching via unidirectional PatternSynonym
* uses simple doctest for testing
* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME`
-* remove TH, it sucks
diff --git a/hpath.cabal b/hpath.cabal
index d9be763..47df8f9 100644
--- a/hpath.cabal
+++ b/hpath.cabal
@@ -1,5 +1,5 @@
name: hpath
-version: 0.10.0
+version: 0.10.1
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
license: BSD3
@@ -36,6 +36,8 @@ library
, deepseq
, exceptions
, hpath-filepath >= 0.10 && < 0.11
+ , template-haskell
+ , utf8-string
, word8
source-repository head
diff --git a/src/HPath.hs b/src/HPath.hs
index f6369ea..bdbdf5f 100644
--- a/src/HPath.hs
+++ b/src/HPath.hs
@@ -16,6 +16,8 @@
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
module HPath
(
@@ -50,6 +52,10 @@ module HPath
,withAbsPath
,withRelPath
,withFnPath
+ -- * Quasiquoters
+ ,abs
+ ,rel
+ ,fn
)
where
@@ -62,10 +68,15 @@ import Data.ByteString(ByteString)
import qualified Data.List as L
#endif
import qualified Data.ByteString as BS
+import Data.ByteString.UTF8
import Data.Data
import Data.Maybe
import Data.Word8
import HPath.Internal
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (Exp(..), Lift(..), lift)
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+import Prelude hiding (abs)
import System.Posix.FilePath hiding ((</>))
@@ -374,3 +385,63 @@ withFnPath (MkPath p) action = action p
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
#endif
+
+
+------------------------
+-- QuasiQuoters
+
+instance Lift (Path a) where
+ lift (MkPath bs) = AppE <$> [| MkPath . BS.pack |] <*> lift (BS.unpack bs)
+
+
+qq :: (ByteString -> Q Exp) -> QuasiQuoter
+qq quoteExp' =
+ QuasiQuoter
+ { quoteExp = (\s -> quoteExp' . fromString $ s)
+ , quotePat = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
+ , quoteType = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"
+ , quoteDec = \_ ->
+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
+ }
+
+mkAbs :: ByteString -> Q Exp
+mkAbs = either (error . show) lift . parseAbs
+
+mkRel :: ByteString -> Q Exp
+mkRel = either (error . show) lift . parseRel
+
+mkFN :: ByteString -> Q Exp
+mkFN = either (error . show) lift . parseFn
+
+-- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8.
+--
+-- >>> [abs|/etc/profile|] :: Path Abs
+-- "/etc/profile"
+-- >>> [abs|/|] :: Path Abs
+-- "/"
+-- >>> [abs|/|] :: Path Abs
+-- "/\239\131\144"
+abs :: QuasiQuoter
+abs = qq mkAbs
+
+-- | Quasiquote a relative Path. This accepts Unicode Chars and will encode as UTF-8.
+--
+-- >>> [rel|etc|] :: Path Rel
+-- "etc"
+-- >>> [rel|bar/baz|] :: Path Rel
+-- "bar/baz"
+-- >>> [rel||] :: Path Rel
+-- "\239\131\144"
+rel :: QuasiQuoter
+rel = qq mkRel
+
+-- | Quasiquote a file name. This accepts Unicode Chars and will encode as UTF-8.
+--
+-- >>> [fn|etc|] :: Path Fn
+-- "etc"
+-- >>> [fn||] :: Path Fn
+-- "\239\131\144"
+fn :: QuasiQuoter
+fn = qq mkFN