{-# 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     ( dataToExpQ )
import qualified Data.Text                     as T
import qualified Language.Haskell.TH.Syntax    as TH


#if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty MChunk)
#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' (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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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 a. String -> Q a
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

-- 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) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> 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 b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall a b. (a -> b) -> Maybe a -> Maybe b
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)