module Marvin.Internal.Types where
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Data.Aeson
import Data.Aeson.Types
import Data.Char (isAlphaNum, isLetter)
import qualified Data.Configurator.Types as C
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Marvin.Interpolate.Text
import Text.Read (readMaybe)
import Control.Monad.Reader
import Control.Monad.Base
import Control.Monad.Trans.Control
type Topic = L.Text
type Message = L.Text
data Event a
= MessageEvent (User a) (Channel a) Message TimeStamp
| CommandEvent (User a) (Channel a) Message TimeStamp
| ChannelJoinEvent (User a) (Channel a) TimeStamp
| ChannelLeaveEvent (User a) (Channel a) TimeStamp
| TopicChangeEvent (User a) (Channel a) Topic TimeStamp
newtype AdapterM a r = AdapterM { runAdapterAction :: ReaderT (C.Config, a) RunnerM r } deriving (MonadIO, Monad, Applicative, Functor, MonadLogger, MonadLoggerIO, MonadBase IO)
instance MonadBaseControl IO (AdapterM a) where
type StM (AdapterM a) r = r
liftBaseWith f = AdapterM $ liftBaseWith $ \q -> f (q . runAdapterAction)
restoreM = AdapterM . restoreM
instance AccessAdapter (AdapterM a) where
type AdapterT (AdapterM a) = a
getAdapter = AdapterM $ snd <$> ask
type EventHandler a = Event a -> IO ()
type RunWithAdapter a = EventHandler a -> AdapterM a ()
class IsAdapter a where
type User a
type Channel a
adapterId :: AdapterId a
messageChannel :: Channel a -> L.Text -> AdapterM a ()
initAdapter :: RunnerM a
runWithAdapter :: RunWithAdapter a
getUsername :: User a -> AdapterM a L.Text
getChannelName :: Channel a -> AdapterM a L.Text
resolveChannel :: L.Text -> AdapterM a (Maybe (Channel a))
newtype User' a = User' {unwrapUser' :: User a}
newtype Channel' a = Channel' {unwrapChannel' :: Channel a}
newtype TimeStamp = TimeStamp { unwrapTimeStamp :: UTCTime } deriving Show
timestampFromNumber :: Value -> Parser TimeStamp
timestampFromNumber (Number n) = return $ TimeStamp $ posixSecondsToUTCTime $ realToFrac n
timestampFromNumber (String s) = maybe mzero (return . TimeStamp . posixSecondsToUTCTime . realToFrac) (readMaybe (T.unpack s) :: Maybe Double)
timestampFromNumber _ = mzero
newtype ScriptId = ScriptId { unwrapScriptId :: T.Text } deriving (Show, Eq)
newtype AdapterId a = AdapterId { unwrapAdapterId :: T.Text } deriving (Show, Eq)
instance ShowT ScriptId where showT = unwrapScriptId
instance ShowT (AdapterId a) where showT = unwrapAdapterId
applicationScriptId :: ScriptId
applicationScriptId = ScriptId "bot"
type RunnerM = LoggingT IO
verifyIdString :: String -> (String -> a) -> String -> a
verifyIdString name _ "" = error $ name ++ " must not be empty"
verifyIdString name f s@(x:xs)
| isLetter x && all (\c -> isAlphaNum c || c == '-' || c == '_' ) xs = f s
| otherwise = error $ "first character of " ++ name ++ " must be a letter, all other characters can be alphanumeric, '-' or '_'"
instance IsString ScriptId where
fromString = verifyIdString "script id" (ScriptId . fromString)
instance IsString (AdapterId a) where
fromString = verifyIdString "adapter id" (AdapterId . fromString)
class HasScriptId s a | s -> a where
scriptId :: Lens' s a
class (IsScript m, MonadIO m) => HasConfigAccess m where
getConfigInternal :: m C.Config
class IsScript m where
getScriptId :: m ScriptId
instance C.Configured LogLevel where
convert (C.String s) =
case T.strip $ T.toLower s of
"debug" -> Just LevelDebug
"warning" -> Just LevelWarn
"error" -> Just LevelError
"info" -> Just LevelInfo
_ -> Nothing
convert _ = Nothing
class AccessAdapter m where
type AdapterT m
getAdapter :: m (AdapterT m)