{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module GHCup.Utils.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 ( Lift
, dataToExpQ
)
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif
qq :: (Text -> Q Exp) -> QuasiQuoter
qq :: (Text -> Q Exp) -> QuasiQuoter
qq Text -> Q Exp
quoteExp' = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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 (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 (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 (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 (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 (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 (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 (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 (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. Lift t => t -> Q Exp
TH.lift (Text -> String
T.unpack Text
txt)
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
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)