{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}

module StrongPath.TH
  ( -- ** QuasiQuoters
    -- $quasiQuoters
    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

-- $quasiQuoters
-- StrongPath provides quasi quoters that enable you to construct 'Path' in compile time.
-- You will need to enable 'QuasiQuotes' language extension in order to use them.
-- With quasi quoters, you can define paths like this:
--
-- > dirFooAbsPath :: Path System Abs (Dir FooDir)
-- > dirFooAbsPath = [absdir|/foo/bar|]
--
-- > someFile :: Path Posix (Rel FooDir) File ()
-- > someFile = [relfileP|some/file.txt|]
--
-- These will run at compile-time and underneath use the appropriate parser, ensuring that paths are valid and throwing compile-time error if not.

-- TODO: Split these into a separate module, StrongPath.QuasiQuoters, that will be reexported from this module.
--   This will also need extraction of some other parts of this module, in order to avoid cyclic imports.

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")|])