{-# 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 { Loader v m -> ResourceKey -> m (Maybe v)
loadMaybe :: ResourceKey -> m (Maybe v) }
   deriving (forall x. Loader v m -> Rep (Loader v m) x)
-> (forall x. Rep (Loader v m) x -> Loader v m)
-> Generic (Loader v m)
forall x. Rep (Loader v m) x -> Loader v m
forall x. Loader v m -> Rep (Loader v m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v (m :: * -> *) x. Rep (Loader v m) x -> Loader v m
forall v (m :: * -> *) x. Loader v m -> Rep (Loader v m) x
$cto :: forall v (m :: * -> *) x. Rep (Loader v m) x -> Loader v m
$cfrom :: forall v (m :: * -> *) x. Loader v m -> Rep (Loader v m) x
G.Generic

-- | Throws 'ResourceNotFound'.

load :: forall r v m . (FromResource r, Typeable r, Typeable v, Monad m) => Loader v m -> m v
load :: Loader v m -> m v
load Loader v m
loader = do
  let key :: ResourceKey
key = FromResource r => ResourceKey
forall a. FromResource a => ResourceKey
resourceKey @r
  Maybe v
mb <- Loader v m -> ResourceKey -> m (Maybe v)
forall v (m :: * -> *). Loader v m -> ResourceKey -> m (Maybe v)
loadMaybe Loader v m
loader ResourceKey
key
  case Maybe v
mb of
    Maybe v
Nothing -> ResourceNotFound -> m v
forall a e. Exception e => e -> a
throw (ResourceNotFound -> m v) -> ResourceNotFound -> m v
forall a b. (a -> b) -> a -> b
$ TypeRep -> ResourceKey -> TypeRep -> ResourceNotFound
ResourceNotFound (Proxy r -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy r
forall k (t :: k). Proxy t
Proxy @r)) ResourceKey
key (Proxy v -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy v
forall k (t :: k). Proxy t
Proxy @v)) 
    Just v
b -> v -> m v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
b

-- | The left 'Loader' is consulted first.

instance Monad m => Semigroup (Loader v m) where
  -- KnownKeysLoader l1 <> KnownKeysLoader l2 = KnownKeysLoader (l1 <> l2)

   Loader ResourceKey -> m (Maybe v)
f <> :: Loader v m -> Loader v m -> Loader v m
<> Loader ResourceKey -> m (Maybe v)
g = (ResourceKey -> m (Maybe v)) -> Loader v m
forall v (m :: * -> *). (ResourceKey -> m (Maybe v)) -> Loader v m
Loader \ResourceKey
key -> do
     let Alt (MaybeT m (Maybe v)
m) = ((ResourceKey -> m (Maybe v)) -> ResourceKey -> Alt (MaybeT m) v
coerce ResourceKey -> m (Maybe v)
f (ResourceKey -> Alt (MaybeT m) v)
-> (ResourceKey -> Alt (MaybeT m) v)
-> ResourceKey
-> Alt (MaybeT m) v
forall a. Semigroup a => a -> a -> a
<> (ResourceKey -> m (Maybe v)) -> ResourceKey -> Alt (MaybeT m) v
coerce ResourceKey -> m (Maybe v)
g) ResourceKey
key
     m (Maybe v)
m

instance Monad m => Monoid (Loader v m) where
  mempty :: Loader v m
mempty = (ResourceKey -> m (Maybe v)) -> Loader v m
forall v (m :: * -> *). (ResourceKey -> m (Maybe v)) -> Loader v m
Loader \ResourceKey
_ -> Maybe v -> m (Maybe v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe v
forall a. Maybe a
Nothing

data ResourceKey = ResourceKey
  { ResourceKey -> [ModuleName]
modulePath :: [ModuleName],
    ResourceKey -> ModuleName
datatypeName :: DatatypeName
  }
  deriving (Int -> ResourceKey -> ShowS
[ResourceKey] -> ShowS
ResourceKey -> ModuleName
(Int -> ResourceKey -> ShowS)
-> (ResourceKey -> ModuleName)
-> ([ResourceKey] -> ShowS)
-> Show ResourceKey
forall a.
(Int -> a -> ShowS)
-> (a -> ModuleName) -> ([a] -> ShowS) -> Show a
showList :: [ResourceKey] -> ShowS
$cshowList :: [ResourceKey] -> ShowS
show :: ResourceKey -> ModuleName
$cshow :: ResourceKey -> ModuleName
showsPrec :: Int -> ResourceKey -> ShowS
$cshowsPrec :: Int -> ResourceKey -> ShowS
Show, ResourceKey -> ResourceKey -> Bool
(ResourceKey -> ResourceKey -> Bool)
-> (ResourceKey -> ResourceKey -> Bool) -> Eq ResourceKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResourceKey -> ResourceKey -> Bool
$c/= :: ResourceKey -> ResourceKey -> Bool
== :: ResourceKey -> ResourceKey -> Bool
$c== :: ResourceKey -> ResourceKey -> Bool
Eq, Eq ResourceKey
Eq ResourceKey
-> (ResourceKey -> ResourceKey -> Ordering)
-> (ResourceKey -> ResourceKey -> Bool)
-> (ResourceKey -> ResourceKey -> Bool)
-> (ResourceKey -> ResourceKey -> Bool)
-> (ResourceKey -> ResourceKey -> Bool)
-> (ResourceKey -> ResourceKey -> ResourceKey)
-> (ResourceKey -> ResourceKey -> ResourceKey)
-> Ord ResourceKey
ResourceKey -> ResourceKey -> Bool
ResourceKey -> ResourceKey -> Ordering
ResourceKey -> ResourceKey -> ResourceKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResourceKey -> ResourceKey -> ResourceKey
$cmin :: ResourceKey -> ResourceKey -> ResourceKey
max :: ResourceKey -> ResourceKey -> ResourceKey
$cmax :: ResourceKey -> ResourceKey -> ResourceKey
>= :: ResourceKey -> ResourceKey -> Bool
$c>= :: ResourceKey -> ResourceKey -> Bool
> :: ResourceKey -> ResourceKey -> Bool
$c> :: ResourceKey -> ResourceKey -> Bool
<= :: ResourceKey -> ResourceKey -> Bool
$c<= :: ResourceKey -> ResourceKey -> Bool
< :: ResourceKey -> ResourceKey -> Bool
$c< :: ResourceKey -> ResourceKey -> Bool
compare :: ResourceKey -> ResourceKey -> Ordering
$ccompare :: ResourceKey -> ResourceKey -> Ordering
$cp1Ord :: Eq ResourceKey
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 = [ModuleName] -> ModuleName -> ResourceKey
ResourceKey (ModuleName -> ModuleName -> [ModuleName]
forall a. Eq a => [a] -> [a] -> [[a]]
Data.List.Split.splitOn ModuleName
"." (Proxy mod -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy mod
forall k (t :: k). Proxy t
Proxy @mod))) (Proxy name -> ModuleName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> ModuleName
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @name))

data ResourceNotFound = ResourceNotFound TypeRep ResourceKey TypeRep deriving (Int -> ResourceNotFound -> ShowS
[ResourceNotFound] -> ShowS
ResourceNotFound -> ModuleName
(Int -> ResourceNotFound -> ShowS)
-> (ResourceNotFound -> ModuleName)
-> ([ResourceNotFound] -> ShowS)
-> Show ResourceNotFound
forall a.
(Int -> a -> ShowS)
-> (a -> ModuleName) -> ([a] -> ShowS) -> Show a
showList :: [ResourceNotFound] -> ShowS
$cshowList :: [ResourceNotFound] -> ShowS
show :: ResourceNotFound -> ModuleName
$cshow :: ResourceNotFound -> ModuleName
showsPrec :: Int -> ResourceNotFound -> ShowS
$cshowsPrec :: Int -> ResourceNotFound -> ShowS
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 :: ModuleName -> DataDir
dataDir ModuleName
dirPath ModuleName
filePath = DataDir
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
dirPath ModuleName -> ShowS
</> ModuleName
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 -> ModuleName -> DataDir
extendDataDir DataDir
dataDir ModuleName
relDir ModuleName
filePath = DataDir
dataDir (ModuleName
relDir ModuleName -> ShowS
</> ModuleName
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 :: [ModuleName] -> DataDir -> Loader ByteString m
dataDirLoader [ModuleName]
extensions DataDir
base = (ResourceKey -> m (Maybe ByteString)) -> Loader ByteString m
forall v (m :: * -> *). (ResourceKey -> m (Maybe v)) -> Loader v m
Loader \ResourceKey {[ModuleName]
modulePath :: [ModuleName]
modulePath :: ResourceKey -> [ModuleName]
modulePath, ModuleName
datatypeName :: ModuleName
datatypeName :: ResourceKey -> ModuleName
datatypeName} -> do
  let go :: [ModuleName] -> m (Maybe ByteString)
go [] = do 
        Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
      go (ModuleName
ext : [ModuleName]
exts) = do
        let relative :: ModuleName
relative = [ModuleName] -> ModuleName
joinPath [ModuleName]
modulePath ModuleName -> ShowS
</> ModuleName -> ShowS
addExtension ModuleName
datatypeName ModuleName
ext
        ModuleName
absolute <- IO ModuleName -> m ModuleName
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModuleName -> m ModuleName) -> IO ModuleName -> m ModuleName
forall a b. (a -> b) -> a -> b
$ DataDir
base ModuleName
relative
        Maybe ByteString
mbytes <- ModuleName -> m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
ModuleName -> m (Maybe ByteString)
readFileMaybe ModuleName
absolute
        case Maybe ByteString
mbytes of
          Just ByteString
bs -> Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> Maybe ByteString -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
          Maybe ByteString
Nothing -> [ModuleName] -> m (Maybe ByteString)
go [ModuleName]
exts
  [ModuleName] -> m (Maybe ByteString)
go [ModuleName]
extensions
  where
  readFileMaybe :: MonadIO m => FilePath -> m (Maybe ByteString)
  readFileMaybe :: ModuleName -> m (Maybe ByteString)
readFileMaybe ModuleName
absolute = do
    Bool
exists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ModuleName -> IO Bool
doesFileExist ModuleName
absolute)
    if Bool -> Bool
not Bool
exists
      then do
        Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
      else do
        ByteString
bytes <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ModuleName -> IO ByteString
Data.ByteString.readFile ModuleName
absolute
        Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bytes)