Resource.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}

module Axel.Monad.Resource where

import Axel.Monad.FileSystem as FS (MonadFileSystem(readFile))

import Control.Monad ((>=>))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Identity (IdentityT)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST)
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST)
import Control.Monad.Trans.Reader (ReaderT)
import qualified Control.Monad.Trans.State.Lazy as LazyState (StateT)
import qualified Control.Monad.Trans.State.Strict as StrictState (StateT)
import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter (WriterT)
import qualified Control.Monad.Trans.Writer.Strict as StrictWriter (WriterT)

import Paths_axel (getDataFileName)

import System.FilePath ((</>))

newtype ResourceId =
  ResourceId String

class (Monad m) =>
      MonadResource m
  where
  getResourcePath :: ResourceId -> m FilePath
  default getResourcePath :: (MonadTrans t, MonadResource m', m ~ t m') =>
    ResourceId -> m FilePath
  getResourcePath = lift . getResourcePath

instance (MonadResource m) => MonadResource (ContT r m)

instance (MonadResource m) => MonadResource (ExceptT e m)

instance (MonadResource m) => MonadResource (IdentityT m)

instance (MonadResource m) => MonadResource (MaybeT m)

instance (MonadResource m) => MonadResource (ReaderT r m)

instance (Monoid w, MonadResource m) =>
         MonadResource (LazyRWS.RWST r w s m)

instance (Monoid w, MonadResource m) =>
         MonadResource (StrictRWS.RWST r w s m)

instance (MonadResource m) => MonadResource (LazyState.StateT s m)

instance (MonadResource m) => MonadResource (StrictState.StateT s m)

instance (Monoid w, MonadResource m) =>
         MonadResource (LazyWriter.WriterT w m)

instance (Monoid w, MonadResource m) =>
         MonadResource (StrictWriter.WriterT w m)

instance {-# OVERLAPPABLE #-} (Monad m, MonadIO m) => MonadResource m where
  getResourcePath :: ResourceId -> m FilePath
  getResourcePath (ResourceId resource) =
    liftIO $ getDataFileName ("resources" </> resource)

readResource :: (MonadFileSystem m, MonadResource m) => ResourceId -> m String
readResource = getResourcePath >=> FS.readFile

astDefinition :: ResourceId
astDefinition = ResourceId "autogenerated/macros/AST.hs"

macroDefinitionAndEnvironmentFooter :: ResourceId
macroDefinitionAndEnvironmentFooter =
  ResourceId "macros/MacroDefinitionAndEnvironmentFooter.hs"

macroDefinitionAndEnvironmentHeader :: ResourceId
macroDefinitionAndEnvironmentHeader =
  ResourceId "macros/MacroDefinitionAndEnvironmentHeader.hs"

macroScaffold :: ResourceId
macroScaffold = ResourceId "macros/Scaffold.hs"

newProjectTemplate :: ResourceId
newProjectTemplate = ResourceId "new-project-template"