{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- | Parser for Dhall configuration files.
--
-- Use `Dhall.TH.makeHaskellTypes` to create the Haskell type first. And then
-- call `parse` from your Shake action.
module Rib.Parser.Dhall
  ( -- * Parsing
    parse,
  )
where

import Development.Shake
import Dhall (FromDhall, auto, input)
import Path
import Relude
import Rib.Shake (ribInputDir)
import System.Directory

-- | Parse a Dhall file as Haskell type.
parse ::
  FromDhall a =>
  -- | Dependent .dhall files, which must trigger a rebuild
  [Path Rel File] ->
  -- | The Dhall file to parse. Relative to `ribInputDir`.
  Path Rel File ->
  Action a
parse :: [Path Rel File] -> Path Rel File -> Action a
parse ((Path Rel File -> FilePath) -> [Path Rel File] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath -> [FilePath]
deps) f :: Path Rel File
f = do
  Path Rel Dir
inputDir <- Action (Path Rel Dir)
ribInputDir
  Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath]
deps
  Text
s <- FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> Action FilePath -> Action Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Partial => FilePath -> Action FilePath
FilePath -> Action FilePath
readFile' (Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath) -> Path Rel File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Rel Dir
inputDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f)
  IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Action a) -> IO a -> Action a
forall a b. (a -> b) -> a -> b
$ FilePath -> IO a -> IO a
forall a. FilePath -> IO a -> IO a
withCurrentDirectory (Path Rel Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel Dir
inputDir) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
    Decoder a -> Text -> IO a
forall a. Decoder a -> Text -> IO a
input Decoder a
forall a. FromDhall a => Decoder a
auto Text
s