ghcup-hs/lib/GHCup/Prelude/Version/QQ.hs

86 lines
2.3 KiB
Haskell
Raw Normal View History

2020-01-11 20:15:05 +00:00
{-# OPTIONS_GHC -Wno-orphans #-}
2020-04-09 17:53:22 +00:00
{-# LANGUAGE CPP #-}
2020-01-11 20:15:05 +00:00
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
2022-01-12 21:55:00 +00:00
{-# LANGUAGE TemplateHaskellQuotes #-}
2020-01-11 20:15:05 +00:00
2020-07-21 23:08:58 +00:00
{-|
Module : GHCup.Utils.Version.QQ
Description : Version quasi-quoters
Copyright : (c) Julian Ospald, 2020
2020-07-30 18:04:02 +00:00
License : LGPL-3.0
2020-07-21 23:08:58 +00:00
Maintainer : hasufell@hasufell.de
Stability : experimental
2021-05-14 21:09:45 +00:00
Portability : portable
2020-07-21 23:08:58 +00:00
-}
2022-05-21 20:54:18 +00:00
module GHCup.Prelude.Version.QQ where
2020-01-11 20:15:05 +00:00
import Data.Data
import Data.Text ( Text )
import Data.Versions
2020-04-09 17:53:22 +00:00
#if !MIN_VERSION_base(4,13,0)
import GHC.Base
#endif
2020-01-11 20:15:05 +00:00
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( dataToExpQ )
2020-01-11 20:15:05 +00:00
import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH
2020-04-09 17:53:22 +00:00
#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
2021-11-02 18:53:22 +00:00
deriving instance Lift (NonEmpty MChunk)
2020-04-09 17:53:22 +00:00
#endif
2020-01-11 20:15:05 +00:00
qq :: (Text -> Q Exp) -> QuasiQuoter
qq quoteExp' = QuasiQuoter
2021-03-11 16:03:51 +00:00
{ quoteExp = \s -> quoteExp' . T.pack $ s
2020-01-11 20:15:05 +00:00
, quotePat = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
, quoteType = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a type)"
, quoteDec = \_ -> fail
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
}
vver :: QuasiQuoter
vver = qq mkV
where
mkV :: Text -> Q Exp
mkV = either (fail . show) liftDataWithText . version
mver :: QuasiQuoter
mver = qq mkV
where
mkV :: Text -> Q Exp
mkV = either (fail . show) liftDataWithText . mess
sver :: QuasiQuoter
sver = qq mkV
where
mkV :: Text -> Q Exp
mkV = either (fail . show) liftDataWithText . semver
vers :: QuasiQuoter
vers = qq mkV
where
mkV :: Text -> Q Exp
mkV = either (fail . show) liftDataWithText . versioning
pver :: QuasiQuoter
pver = qq mkV
where
mkV :: Text -> Q Exp
mkV = either (fail . show) liftDataWithText . pvp
-- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable
liftText :: T.Text -> Q Exp
liftText txt = AppE (VarE 'T.pack) <$> TH.lift (T.unpack txt)
liftDataWithText :: Data a => a -> Q Exp
2021-03-11 16:03:51 +00:00
liftDataWithText = dataToExpQ (fmap liftText . cast)