{-# OPTIONS_GHC -Wno-orphans    #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift         #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}


{-|
Module      : GHCup.Utils.Version.QQ
Description : Version quasi-quoters
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
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     ( 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
  { quoteExp :: String -> Q Exp
quoteExp  = \String
s -> Text -> Q Exp
quoteExp' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
s
  , quotePat :: String -> Q Pat
quotePat  = \String
_ ->
    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
_ ->
    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
_ -> 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. Data a => a -> Q Exp
liftDataWithText 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. Data a => a -> Q Exp
liftDataWithText 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. Data a => a -> Q Exp
liftDataWithText 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. Data a => a -> Q Exp
liftDataWithText 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. Data a => a -> Q Exp
liftDataWithText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError PVP
pvp

-- https://stackoverflow.com/questions/38143464/cant-find-inerface-file-declaration-for-variable
liftText :: T.Text -> Q Exp
liftText :: Text -> Q Exp
liftText Text
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'T.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> 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 (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)