{-# 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.Utils.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 :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
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 (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 (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 (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 (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 (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 (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 (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 (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. Lift t => t -> Q Exp
TH.lift (Text -> String
T.unpack Text
txt)

liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
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)