{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module                  : Language.Jsonnet.Std.TH
-- Copyright               : (c) 2020-2021 Alexandre Moreno
-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0
-- Maintainer              : Alexandre Moreno <alexmorenocano@gmail.com>
-- Stability               : experimental
-- Portability             : non-portable
module Language.Jsonnet.Std.TH where

import qualified Data.Text.IO as TIO
import Language.Haskell.TH
import Language.Haskell.TH.Quote ()
import Language.Haskell.TH.Syntax (addDependentFile)
import Language.Jsonnet.TH (compile)
import TH.RelativePaths (pathRelativeToCabalPackage)

stdlibPath :: String
stdlibPath :: String
stdlibPath = String
"stdlib/std.jsonnet"

mkStdlib :: Q Exp
mkStdlib :: Q Exp
mkStdlib = do
  String
fp <- String -> Q String
pathRelativeToCabalPackage String
stdlibPath
  String -> Q ()
addDependentFile String
fp
  Text
src <- IO Text -> Q Text
forall a. IO a -> Q a
runIO (String -> IO Text
TIO.readFile String
stdlibPath)
  Exp
lbs <- String -> Text -> Q Exp
compile String
stdlibPath Text
src
  Exp -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp
lbs