{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module GHCup.Prelude.Version.QQ where
import Data.Data
import Data.Text ( Text )
import Data.Versions
#if !MIN_VERSION_base(4,13,0)
import GHC.Base
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( dataToExpQ )
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty MChunk)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter
qq :: (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
quoteExp' = QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = \String
s -> Text -> Q Exp
quoteExp' (Text -> Q Exp) -> (String -> Text) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
s
, quotePat :: String -> Q Pat
quotePat = \String
_ ->
String -> Q Pat
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a pattern)"
, 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 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 only, used as a declaration)"
}
vver :: QuasiQuoter
vver :: QuasiQuoter
vver = (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
mkV
where
mkV :: Text -> Q Exp
mkV :: Text -> Q Exp
mkV = (ParsingError -> Q Exp)
-> (Version -> Q Exp) -> Either ParsingError Version -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (ParsingError -> String) -> ParsingError -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) Version -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Either ParsingError Version -> Q Exp)
-> (Text -> Either ParsingError Version) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
version
mver :: QuasiQuoter
mver :: QuasiQuoter
mver = (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
mkV
where
mkV :: Text -> Q Exp
mkV :: Text -> Q Exp
mkV = (ParsingError -> Q Exp)
-> (Mess -> Q Exp) -> Either ParsingError Mess -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (ParsingError -> String) -> ParsingError -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) Mess -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Either ParsingError Mess -> Q Exp)
-> (Text -> Either ParsingError Mess) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Mess
mess
sver :: QuasiQuoter
sver :: QuasiQuoter
sver = (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
mkV
where
mkV :: Text -> Q Exp
mkV :: Text -> Q Exp
mkV = (ParsingError -> Q Exp)
-> (SemVer -> Q Exp) -> Either ParsingError SemVer -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (ParsingError -> String) -> ParsingError -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) SemVer -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Either ParsingError SemVer -> Q Exp)
-> (Text -> Either ParsingError SemVer) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError SemVer
semver
vers :: QuasiQuoter
vers :: QuasiQuoter
vers = (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
mkV
where
mkV :: Text -> Q Exp
mkV :: Text -> Q Exp
mkV = (ParsingError -> Q Exp)
-> (Versioning -> Q Exp) -> Either ParsingError Versioning -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (ParsingError -> String) -> ParsingError -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) Versioning -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Either ParsingError Versioning -> Q Exp)
-> (Text -> Either ParsingError Versioning) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning
pver :: QuasiQuoter
pver :: QuasiQuoter
pver = (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
mkV
where
mkV :: Text -> Q Exp
mkV :: Text -> Q Exp
mkV = (ParsingError -> Q Exp)
-> (PVP -> Q Exp) -> Either ParsingError PVP -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (ParsingError -> String) -> ParsingError -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) PVP -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Either ParsingError PVP -> Q Exp)
-> (Text -> Either ParsingError PVP) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError PVP
pvp
liftText :: T.Text -> Q Exp
liftText :: Text -> Q Exp
liftText Text
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'T.pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.lift (Text -> String
T.unpack Text
txt)
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: forall a. Data a => a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText (Maybe Text -> Maybe (Q Exp))
-> (b -> Maybe Text) -> b -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)