{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      : Verismith.Verilog.Quote
-- Description : QuasiQuotation for verilog code in Haskell.
-- Copyright   : (c) 2019, Yann Herklotz Grave
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
--
-- QuasiQuotation for verilog code in Haskell.
module Verismith.Verilog.Quote
  ( verilog,
  )
where

import Data.Data
import qualified Data.Text as T
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Verismith.Verilog.AST (Verilog)
import Verismith.Verilog.Parser

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 ((forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp)
-> (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a b. (a -> b) -> a -> b
$ (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

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
lift (Text -> String
T.unpack Text
txt)

-- | Quasiquoter for verilog, so that verilog can be written inline and be
-- parsed to an AST at compile time.
verilog :: QuasiQuoter
verilog :: QuasiQuoter
verilog =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteVerilog,
      quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined,
      quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }

quoteVerilog :: String -> TH.Q TH.Exp
quoteVerilog :: String -> Q Exp
quoteVerilog String
s = do
  Loc
loc <- Q Loc
TH.location
  let pos :: Text
pos = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Loc -> String
TH.loc_filename Loc
loc
  Verilog ()
v <- case Text -> Text -> Either Text (Verilog ())
forall ann. Text -> Text -> Either Text (Verilog ann)
parseVerilog Text
pos (String -> Text
T.pack String
s) of
    Right Verilog ()
e -> Verilog () -> Q (Verilog ())
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Verilog ()
e
    Left Text
e -> String -> Q (Verilog ())
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q (Verilog ())) -> String -> Q (Verilog ())
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
e
  Verilog () -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText (Verilog ()
v :: Verilog ())