content: {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE InstanceSigs #-}
  {-# LANGUAGE FlexibleInstances #-}
  
  module Effect
    ( Effect
    , EffectF(..)
    , Selector(..)
    , Condition(..)
    , Order(..)
    , say
    , logMsg
    , createEntity
    , getEntityById
    , deleteEntityById
    , updateEntityById
    , selectEntities
    , deleteEntities
    , httpRequest
    , now
    , timeout
    , errorEff
    , twitchApiRequest
    , listen
    , periodicEffect
    , periodicEffect'
    , twitchCommand
    , randomMarkov
    , reloadMarkov
    , githubApiRequest
    , randomEff
    ) where
  
  import Control.Monad.Catch
  import qualified Data.ByteString.Lazy.Char8 as B8
  import Data.Proxy
  import qualified Data.Text as T
  import Data.Time
  import Entity
  import Free
  import Network.HTTP.Simple (Request, Response)
  import Property
  import Transport
  
  data Condition
    = PropertyEquals T.Text
                     Property
    | PropertyGreater T.Text
                      Property
    | PropertyMissing T.Text
    | PropertyTextLike T.Text
                       T.Text
    | ConditionAnd [Condition]
    deriving (Show)
  
  data Order
    = Asc
    | Desc
    deriving (Show)
  
  data Selector
    = All
    | Filter Condition
             Selector
    | Shuffle Selector
    | Take Int
           Selector
    | SortBy T.Text
             Order
             Selector
    deriving (Show)
  
  data EffectF s
    = Say Channel
          T.Text
          s
    | LogMsg T.Text
             s
    | ErrorEff T.Text
    | CreateEntity T.Text
                   Properties
                   (Entity Properties -> s)
    | GetEntityById T.Text
                    Int
                    (Maybe (Entity Properties) -> s)
    | DeleteEntityById T.Text
                       Int
                       s
    | UpdateEntityById (Entity Properties)
                       (Maybe (Entity Properties) -> s)
    | SelectEntities T.Text
                     Selector
                     ([Entity Properties] -> s)
    | DeleteEntities T.Text
                     Selector
                     (Int -> s)
    | Now (UTCTime -> s)
    | HttpRequest Request
                  (Response B8.ByteString -> s)
    | TwitchApiRequest Request
                       (Response B8.ByteString -> s)
    | GitHubApiRequest Request
                       (Response B8.ByteString -> s)
    | TimeoutEff Integer
                 (Maybe Channel)
                 (Effect ())
                 s
    | Listen (Effect ())
             ([T.Text] -> s)
    | TwitchCommand Channel
                    T.Text
                    [T.Text]
                    s
    | RandomMarkov (Maybe T.Text -> s)
    | ReloadMarkov (Maybe T.Text -> s)
    | RandomEff (Int, Int)
                (Int -> s)
    deriving (Functor)
  
  type Effect = Free EffectF
  
  instance MonadThrow Effect where
    throwM :: Exception e => e -> Effect a
    throwM = errorEff . T.pack . displayException
  
  say :: Channel -> T.Text -> Effect ()
  say channel msg = liftF $ Say channel msg ()
  
  logMsg :: T.Text -> Effect ()
  logMsg msg = liftF $ LogMsg msg ()
  
  createEntity :: IsEntity e => Proxy e -> e -> Effect (Entity e)
  createEntity proxy entity =
    liftF (CreateEntity (nameOfEntity proxy) (toProperties entity) id) >>=
    fromEntityProperties
  
  getEntityById :: IsEntity e => Proxy e -> Int -> Effect (Maybe (Entity e))
  getEntityById proxy ident =
    fmap (>>= fromEntityProperties) $
    liftF $ GetEntityById (nameOfEntity proxy) ident id
  
  deleteEntityById :: IsEntity e => Proxy e -> Int -> Effect ()
  deleteEntityById proxy ident =
    liftF $ DeleteEntityById (nameOfEntity proxy) ident ()
  
  updateEntityById :: IsEntity e => Entity e -> Effect (Maybe (Entity e))
  updateEntityById entity =
    fmap (>>= fromEntityProperties) $
    liftF $ UpdateEntityById (toProperties <$> entity) id
  
  selectEntities :: IsEntity e => Proxy e -> Selector -> Effect [Entity e]
  selectEntities proxy selector =
    fmap (>>= fromEntityProperties) $
    liftF $ SelectEntities (nameOfEntity proxy) selector id
  
  deleteEntities :: IsEntity e => Proxy e -> Selector -> Effect Int
  deleteEntities proxy selector =
    liftF $ DeleteEntities (nameOfEntity proxy) selector id
  
  now :: Effect UTCTime
  now = liftF $ Now id
  
  httpRequest :: Request -> Effect (Response B8.ByteString)
  httpRequest request = liftF $ HttpRequest request id
  
  twitchApiRequest :: Request -> Effect (Response B8.ByteString)
  twitchApiRequest request = liftF $ TwitchApiRequest request id
  
  githubApiRequest :: Request -> Effect (Response B8.ByteString)
  githubApiRequest request = liftF $ GitHubApiRequest request id
  
  timeout :: Integer -> Maybe Channel -> Effect () -> Effect ()
  timeout t c e = liftF $ TimeoutEff t c e ()
  
  errorEff :: T.Text -> Effect a
  errorEff t = liftF $ ErrorEff t
  
  listen :: Effect () -> Effect [T.Text]
  listen effect = liftF $ Listen effect id
  
  periodicEffect :: Integer -> Maybe Channel -> Effect () -> Effect ()
  periodicEffect period channel effect = do
    effect
    timeout period channel $ periodicEffect period channel effect
  
  periodicEffect' :: Maybe Channel -> Effect (Maybe Integer) -> Effect ()
  periodicEffect' channel effect = do
    period' <- effect
    maybe
      (return ())
      (\period -> timeout period channel $ periodicEffect' channel effect)
      period'
  
  twitchCommand :: Channel -> T.Text -> [T.Text] -> Effect ()
  twitchCommand channel name args = liftF $ TwitchCommand channel name args ()
  
  randomMarkov :: Effect (Maybe T.Text)
  randomMarkov = liftF $ RandomMarkov id
  
  reloadMarkov :: Effect (Maybe T.Text)
  reloadMarkov = liftF $ ReloadMarkov id
  
  randomEff :: (Int, Int) -> Effect Int
  randomEff range = liftF $ RandomEff range id
  