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

108 lines
3.0 KiB
Haskell
Raw Permalink 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(..) )
2020-04-05 08:59:55 +00:00
import Language.Haskell.TH.Syntax ( Lift
2020-01-11 20:15:05 +00:00
, 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
2020-10-24 20:55:35 +00:00
deriving instance Data MChunk
deriving instance Lift MChunk
2020-01-11 20:15:05 +00:00
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
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 VChunk)
deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
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)