{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}
module StrongPath.TH
(
absdir,
absdirP,
absdirW,
absfile,
absfileP,
absfileW,
reldir,
reldirP,
reldirW,
relfile,
relfileP,
relfileW,
)
where
import Control.Monad ((>=>))
import qualified Language.Haskell.TH.Lib as TH
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax (Lift (..))
import qualified Language.Haskell.TH.Syntax as TH
import StrongPath.FilePath
import StrongPath.Internal
qq ::
(Lift p, Show err) =>
(String -> Either err p) ->
(p -> TH.ExpQ) ->
QuasiQuoter
qq :: (String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either err p
parse p -> ExpQ
liftP =
QuasiQuoter :: (String -> ExpQ)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> ExpQ
quoteExp = (err -> ExpQ) -> (p -> ExpQ) -> Either err p -> ExpQ
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ExpQ
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ExpQ) -> (err -> String) -> err -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> String
forall a. Show a => a -> String
show) p -> ExpQ
liftP (Either err p -> ExpQ)
-> (String -> Either err p) -> String -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either err p
parse,
quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
err String
"pattern",
quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
err String
"type",
quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
err String
"declaration"
}
where
err :: String -> String -> m a
err String
what String
x = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", must be expression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
liftPath :: TH.TypeQ -> TH.TypeQ -> TH.TypeQ -> Path s b t -> TH.ExpQ
liftPath :: Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath Q Type
s Q Type
b Q Type
t Path s b t
p = [|$(lift p) :: Path $s $b $t|]
typeVar :: String -> TH.TypeQ
typeVar :: String -> Q Type
typeVar = String -> Q Name
TH.newName (String -> Q Name) -> (Name -> Q Type) -> String -> Q Type
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Q Type
TH.varT
absdir, absdirP, absdirW :: QuasiQuoter
absdir :: QuasiQuoter
absdir = (String -> Either SomeException (Path System Abs (Dir Any)))
-> (Path System Abs (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path System Abs (Dir Any))
forall (m :: * -> *) d.
MonadThrow m =>
String -> m (Path System Abs (Dir d))
parseAbsDir (Q Type -> Q Type -> Q Type -> Path System Abs (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|System|] [t|Abs|] [t|Dir $(typeVar "d")|])
absdirP :: QuasiQuoter
absdirP = (String -> Either SomeException (Path Posix Abs (Dir Any)))
-> (Path Posix Abs (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Posix Abs (Dir Any))
forall (m :: * -> *) d.
MonadThrow m =>
String -> m (Path Posix Abs (Dir d))
parseAbsDirP (Q Type -> Q Type -> Q Type -> Path Posix Abs (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Posix|] [t|Abs|] [t|Dir $(typeVar "d")|])
absdirW :: QuasiQuoter
absdirW = (String -> Either SomeException (Path Windows Abs (Dir Any)))
-> (Path Windows Abs (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Windows Abs (Dir Any))
forall (m :: * -> *) d.
MonadThrow m =>
String -> m (Path Windows Abs (Dir d))
parseAbsDirW (Q Type -> Q Type -> Q Type -> Path Windows Abs (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Windows|] [t|Abs|] [t|Dir $(typeVar "d")|])
absfile, absfileP, absfileW :: QuasiQuoter
absfile :: QuasiQuoter
absfile = (String -> Either SomeException (Path System Abs (File Any)))
-> (Path System Abs (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path System Abs (File Any))
forall (m :: * -> *) f.
MonadThrow m =>
String -> m (Path System Abs (File f))
parseAbsFile (Q Type -> Q Type -> Q Type -> Path System Abs (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|System|] [t|Abs|] [t|File $(typeVar "f")|])
absfileP :: QuasiQuoter
absfileP = (String -> Either SomeException (Path Posix Abs (File Any)))
-> (Path Posix Abs (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Posix Abs (File Any))
forall (m :: * -> *) f.
MonadThrow m =>
String -> m (Path Posix Abs (File f))
parseAbsFileP (Q Type -> Q Type -> Q Type -> Path Posix Abs (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Posix|] [t|Abs|] [t|File $(typeVar "f")|])
absfileW :: QuasiQuoter
absfileW = (String -> Either SomeException (Path Windows Abs (File Any)))
-> (Path Windows Abs (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Windows Abs (File Any))
forall (m :: * -> *) f.
MonadThrow m =>
String -> m (Path Windows Abs (File f))
parseAbsFileW (Q Type -> Q Type -> Q Type -> Path Windows Abs (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Windows|] [t|Abs|] [t|File $(typeVar "f")|])
reldir, reldirP, reldirW :: QuasiQuoter
reldir :: QuasiQuoter
reldir = (String -> Either SomeException (Path System (Rel Any) (Dir Any)))
-> (Path System (Rel Any) (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path System (Rel Any) (Dir Any))
forall (m :: * -> *) d1 d2.
MonadThrow m =>
String -> m (Path System (Rel d1) (Dir d2))
parseRelDir (Q Type
-> Q Type -> Q Type -> Path System (Rel Any) (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|System|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|])
reldirP :: QuasiQuoter
reldirP = (String -> Either SomeException (Path Posix (Rel Any) (Dir Any)))
-> (Path Posix (Rel Any) (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Posix (Rel Any) (Dir Any))
forall (m :: * -> *) d1 d2.
MonadThrow m =>
String -> m (Path Posix (Rel d1) (Dir d2))
parseRelDirP (Q Type
-> Q Type -> Q Type -> Path Posix (Rel Any) (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Posix|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|])
reldirW :: QuasiQuoter
reldirW = (String -> Either SomeException (Path Windows (Rel Any) (Dir Any)))
-> (Path Windows (Rel Any) (Dir Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Windows (Rel Any) (Dir Any))
forall (m :: * -> *) d1 d2.
MonadThrow m =>
String -> m (Path Windows (Rel d1) (Dir d2))
parseRelDirW (Q Type
-> Q Type -> Q Type -> Path Windows (Rel Any) (Dir Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Windows|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|])
relfile, relfileP, relfileW :: QuasiQuoter
relfile :: QuasiQuoter
relfile = (String -> Either SomeException (Path System (Rel Any) (File Any)))
-> (Path System (Rel Any) (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path System (Rel Any) (File Any))
forall (m :: * -> *) d f.
MonadThrow m =>
String -> m (Path System (Rel d) (File f))
parseRelFile (Q Type
-> Q Type -> Q Type -> Path System (Rel Any) (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|System|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|])
relfileP :: QuasiQuoter
relfileP = (String -> Either SomeException (Path Posix (Rel Any) (File Any)))
-> (Path Posix (Rel Any) (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Posix (Rel Any) (File Any))
forall (m :: * -> *) d f.
MonadThrow m =>
String -> m (Path Posix (Rel d) (File f))
parseRelFileP (Q Type
-> Q Type -> Q Type -> Path Posix (Rel Any) (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Posix|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|])
relfileW :: QuasiQuoter
relfileW = (String
-> Either SomeException (Path Windows (Rel Any) (File Any)))
-> (Path Windows (Rel Any) (File Any) -> ExpQ) -> QuasiQuoter
forall p err.
(Lift p, Show err) =>
(String -> Either err p) -> (p -> ExpQ) -> QuasiQuoter
qq String -> Either SomeException (Path Windows (Rel Any) (File Any))
forall (m :: * -> *) d f.
MonadThrow m =>
String -> m (Path Windows (Rel d) (File f))
parseRelFileW (Q Type
-> Q Type -> Q Type -> Path Windows (Rel Any) (File Any) -> ExpQ
forall s b t. Q Type -> Q Type -> Q Type -> Path s b t -> ExpQ
liftPath [t|Windows|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|])