Loader.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}

-- | Define resource 'Loader's and wire them into 'Value's.
--
-- Typically, this module only needs to be imported when creating the global
-- application environment.
module Dep.Loader
  ( 
    -- * Resource loader.
    Loader (..),
    ResourceKey (..),
    DatatypeName,
    ModuleName,
    load,
    ResourceNotFound (..),
    -- * Datatypes tied to resources.
    FromResource (..),
    -- * Loaders for resources in a directory.
    dataDirLoader,
    FileExtension,
    DataDir,
    dataDir,
    extendDataDir,
  )
where

import Control.Exception (Exception, throw, throwIO)
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.ByteString
import Data.Functor
import Data.List.Split
import Data.Map.Strict qualified as Map
import Data.Monoid
import Data.Proxy
import GHC.Generics qualified as G
import GHC.TypeLits (KnownSymbol, symbolVal)
import System.Directory (doesFileExist)
import System.FilePath
import Data.Coerce
import GHC.Generics qualified
import System.Console.GetOpt (getOpt)
import Data.Foldable qualified
import Data.Typeable
import Data.Proxy
import System.Environment (lookupEnv)
import Dep.Has
import Dep.Value
import Data.Aeson qualified 
import Data.Text
import Data.Text.Encoding (decodeUtf8')
import Data.Text.Encoding.Error
import Data.List.Split

newtype Loader v m =
   Loader { loadMaybe :: ResourceKey -> m (Maybe v) }
   deriving G.Generic

-- | Throws 'ResourceNotFound'.
load :: forall r v m . (FromResource r, Typeable r, Typeable v, Monad m) => Loader v m -> m v
load loader = do
  let key = resourceKey @r
  mb <- loadMaybe loader key
  case mb of
    Nothing -> throw $ ResourceNotFound (typeRep (Proxy @r)) key (typeRep (Proxy @v)) 
    Just b -> pure b

-- | The left 'Loader' is consulted first.
instance Monad m => Semigroup (Loader v m) where
  -- KnownKeysLoader l1 <> KnownKeysLoader l2 = KnownKeysLoader (l1 <> l2)
   Loader f <> Loader g = Loader \key -> do
     let Alt (MaybeT m) = (coerce f <> coerce g) key
     m

instance Monad m => Monoid (Loader v m) where
  mempty = Loader \_ -> pure Nothing

data ResourceKey = ResourceKey
  { modulePath :: [ModuleName],
    datatypeName :: DatatypeName
  }
  deriving (Show, Eq, Ord)

type DatatypeName = String

type ModuleName = String

type FileExtension = String

-- | Class for datatypes tied to resources.
--
-- Derive it with @DeriveAnyClass@. The datatype must have a "GHC.Generics.Generic" instance.
class FromResource a where
  resourceKey :: ResourceKey
  default resourceKey ::
    forall name mod p n nt x.
    ( G.Generic a,
      G.Rep a ~ G.D1 ('G.MetaData name mod p nt) x,
      KnownSymbol name,
      KnownSymbol mod
    ) =>
    ResourceKey
  resourceKey = ResourceKey (Data.List.Split.splitOn "." (symbolVal (Proxy @mod))) (symbolVal (Proxy @name))

data ResourceNotFound = ResourceNotFound TypeRep ResourceKey TypeRep deriving (Show)

instance Exception ResourceNotFound

-- | Function that completes a relative `FilePath` pointing to a data file,
-- and returns its absolute path.
--
-- The [@getDataFileName@ function from @Paths_pkgname@](https://cabal.readthedocs.io/en/latest/cabal-package.html#accessing-data-files-from-package-code) is a valid 'DataDir'.
-- You can also create a 'DataDir' by using 'dataDir'.
type DataDir = FilePath -> IO FilePath

-- | Build a 'DataDir' out of a base directory path.
dataDir :: FilePath -> DataDir
dataDir dirPath filePath = pure (dirPath </> filePath)

-- | Given a relative path to a subdirectory of a 'DataDir', return a 'DataDir'
-- that completes paths within that subdirectory.
extendDataDir :: DataDir -> FilePath -> DataDir
extendDataDir dataDir relDir filePath = dataDir (relDir </> filePath)

-- | A @dataDirLoader ["js", "json"] (dataDir "conf")@ 'Loader' will, for a datatype @Baz@ defined
-- in module @Foo.Bar@, look for the files @conf\/Foo\/Bar\/Baz.js@ and @conf\/Foo\/Bar\/Baz.json@,
-- in that order.
dataDirLoader :: MonadIO m => [FileExtension] -> DataDir -> Loader ByteString m
dataDirLoader extensions base = Loader \ResourceKey {modulePath, datatypeName} -> do
  let go [] = do 
        pure Nothing
      go (ext : exts) = do
        let relative = joinPath modulePath </> addExtension datatypeName ext
        absolute <- liftIO $ base relative
        mbytes <- readFileMaybe absolute
        case mbytes of
          Just bs -> pure $ Just bs
          Nothing -> go exts
  go extensions
  where
  readFileMaybe :: MonadIO m => FilePath -> m (Maybe ByteString)
  readFileMaybe absolute = do
    exists <- liftIO (doesFileExist absolute)
    if not exists
      then do
        pure Nothing
      else do
        bytes <- liftIO $ Data.ByteString.readFile absolute
        pure (Just bytes)