{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE ViewPatterns #-}
#undef POSIX
#define IS_WINDOWS True
#define WINDOWS
#define FILEPATH_NAME WindowsPath
#define OSSTRING_NAME WindowsString
#define WORD_NAME WindowsChar
#include "Common.hs"
pstr :: QuasiQuoter
pstr :: QuasiQuoter
pstr =
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = \String
s -> do
WindowsString
ps <- (EncodingException -> Q WindowsString)
-> (WindowsString -> Q WindowsString)
-> Either EncodingException WindowsString
-> Q WindowsString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q WindowsString
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q WindowsString)
-> (EncodingException -> String)
-> EncodingException
-> Q WindowsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) WindowsString -> Q WindowsString
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EncodingException WindowsString -> Q WindowsString)
-> Either EncodingException WindowsString -> Q WindowsString
forall a b. (a -> b) -> a -> b
$ TextEncoding -> String -> Either EncodingException WindowsString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
ErrorOnCodingFailure) String
s
Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WindowsString -> Bool
isValid WindowsString
ps) (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"filepath not valid: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WindowsString -> String
forall a. Show a => a -> String
show WindowsString
ps)
WindowsString -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => WindowsString -> m Exp
lift WindowsString
ps
, quotePat :: String -> Q Pat
quotePat = \String
s -> do
WindowsString
osp' <- (EncodingException -> Q WindowsString)
-> (WindowsString -> Q WindowsString)
-> Either EncodingException WindowsString
-> Q WindowsString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q WindowsString
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q WindowsString)
-> (EncodingException -> String)
-> EncodingException
-> Q WindowsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) WindowsString -> Q WindowsString
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EncodingException WindowsString -> Q WindowsString)
-> (String -> Either EncodingException WindowsString)
-> String
-> Q WindowsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> String -> Either EncodingException WindowsString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
ErrorOnCodingFailure) (String -> Q WindowsString) -> String -> Q WindowsString
forall a b. (a -> b) -> a -> b
$ String
s
Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WindowsString -> Bool
isValid WindowsString
osp') (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ String -> Q ()
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"filepath not valid: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WindowsString -> String
forall a. Show a => a -> String
show WindowsString
osp')
[p|((==) osp' -> True)|]
, quoteType :: String -> Q Type
quoteType = \String
_ ->
String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression or pattern only, used as a type)"
, quoteDec :: String -> Q [Dec]
quoteDec = \String
_ ->
String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)"
}