{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, TypeFamilies, RecordWildCards, OverloadedStrings, QuasiQuotes #-}
module Clckwrks.Redirect.Acid
(
RedirectState
, initialRedirectState
, GetRedirect(..)
) where
import Clckwrks (UserId(..))
import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.State (get, modify, put)
import Control.Monad.Trans (liftIO)
import Data.Acid (AcidState, Query, Update, makeAcidic)
import Data.Data (Data, Typeable)
import Data.IxSet (Indexable, IxSet, (@=), Proxy(..), empty, fromList, getOne, ixSet, ixFun, insert, toList, toDescList, updateIx)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Data.SafeCopy (Migrate(..), base, deriveSafeCopy, extension)
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as Text
data RedirectState = RedirectState
{ redirects :: Map [Text] Text
}
deriving (Eq, Read, Show, Data, Typeable)
deriveSafeCopy 0 'base ''RedirectState
initialRedirectState :: IO RedirectState
initialRedirectState =
pure $ RedirectState { redirects = Map.empty }
getRedirect :: [Text]
-> Query RedirectState (Maybe Text)
getRedirect paths =
do s <- ask
pure $ Map.lookup paths (redirects s)
makeAcidic ''RedirectState
[ 'getRedirect
]