Initial commit

lib/GHCup/Utils/Version/QQ.hs

@@ -0,0 +1,89 @@
+{-# OPTIONS_GHC -Wno-orphans    #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveLift         #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell    #-}
+
+
+module GHCup.Utils.Version.QQ where
+
+import           Data.Data
+import           Data.Text                      ( Text )
+import           Data.Versions
+import           GHC.Base
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Quote      ( QuasiQuoter(..) )
+import           Language.Haskell.TH.Syntax     ( Exp(..)
+                                                , 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 PVP
+deriving instance Lift PVP
+deriving instance Lift (NonEmpty Word)
+deriving instance Lift VSep
+deriving instance Data VSep
+deriving instance Lift VUnit
+deriving instance Data VUnit
+instance Lift Text
+
+qq :: (Text -> Q Exp) -> QuasiQuoter
+qq quoteExp' = QuasiQuoter
+  { quoteExp  = (\s -> quoteExp' . T.pack $ s)
+  , 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
+liftDataWithText = dataToExpQ (\a -> liftText <$> cast a)