{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Neuron.Zettelkasten.Config
  ( Config (..),
    getConfig,
  )
where

import Data.FileEmbed (embedFile)
import Development.Shake (Action, readFile')
import Dhall (FromDhall)
import qualified Dhall
import Dhall.TH
import Path
import Path.IO (doesFileExist)
import Relude
import qualified Rib

-- | Config type for @neuron.dhall@
--
-- See <https://neuron.srid.ca/2011701.html guide> for description of the fields.
makeHaskellTypes
  [ SingleConstructor "Config" "Config" "./src-dhall/Config/Type.dhall"
  ]

deriving instance Generic Config

deriving instance FromDhall Config

defaultConfig :: ByteString
defaultConfig :: ByteString
defaultConfig = $(embedFile "./src-dhall/Config/Default.dhall")

-- | Read the optional @neuron.dhall@ config file from the zettelksaten
getConfig :: Action Config
getConfig :: Action Config
getConfig = do
  Path Rel Dir
inputDir <- Action (Path Rel Dir)
Rib.ribInputDir
  let configPath :: Path Rel t
configPath = Path Rel Dir
inputDir Path Rel Dir -> Path Rel t -> Path Rel t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
forall b t. Path b t
configFile
  Text
configVal :: Text <- Path Rel File -> Action Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Rel File
forall t. Path Rel t
configPath Action Bool -> (Bool -> Action Text) -> Action Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    True -> do
      Text
userConfig <- (String -> Text) -> Action String -> Action Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a. ToText a => a -> Text
toText (Action String -> Action Text) -> Action String -> Action Text
forall a b. (a -> b) -> a -> b
$ Partial => String -> Action String
String -> Action String
readFile' (String -> Action String) -> String -> Action String
forall a b. (a -> b) -> a -> b
$ Path Rel Any -> String
forall b t. Path b t -> String
toFilePath Path Rel Any
forall t. Path Rel t
configPath
      -- Dhall's combine operator (`//`) allows us to merge two records,
      -- effectively merging the record with defaults with the user record.
      Text -> Action Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Action Text) -> Text -> Action Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
defaultConfig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " // " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
userConfig
    False ->
      Text -> Action Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Action Text) -> Text -> Action Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 @Text ByteString
defaultConfig
  IO Config -> Action Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> Action Config) -> IO Config -> Action Config
forall a b. (a -> b) -> a -> b
$ IO Config -> IO Config
forall a. IO a -> IO a
Dhall.detailed (IO Config -> IO Config) -> IO Config -> IO Config
forall a b. (a -> b) -> a -> b
$ Decoder Config -> Text -> IO Config
forall a. Decoder a -> Text -> IO a
Dhall.input Decoder Config
forall a. FromDhall a => Decoder a
Dhall.auto Text
configVal
  where
    configFile :: Path b t
configFile = [relfile|neuron.dhall|]