module Clckwrks.Media.Monad where
import Clckwrks (ClckT(..), ClckFormT, ClckState(..), ClckURL(..), mapClckT)
import Clckwrks.Acid
import Clckwrks.IOThread (IOThread(..), startIOThread, killIOThread)
import Clckwrks.Media.Acid
import Clckwrks.Media.Preview
import Clckwrks.Media.PreProcess (mediaCmd)
import Clckwrks.Media.Types
import Clckwrks.Media.URL
import Control.Applicative ((<$>))
import Control.Exception (bracket)
import Control.Monad.Reader (ReaderT(..), MonadReader(..))
import Data.Acid (AcidState)
import Data.Acid.Local (createCheckpointAndClose, openLocalStateFrom)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Happstack.Server
import Happstack.Server.Internal.Monads (FilterFun)
import HSP.XML (Attribute(MkAttr), XML(..), pAttrVal)
import HSP.XMLGenerator (Attr((:=)), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName))
import Magic (Magic, MagicFlag(..), magicLoadDefault, magicOpen)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import Text.Reform (CommonFormError, FormError(..))
import Web.Routes (showURL)
data MediaConfig = MediaConfig
{ mediaDirectory :: FilePath
, mediaState :: AcidState MediaState
, mediaMagic :: Magic
, mediaIOThread :: IOThread (Medium, PreviewSize) FilePath
, mediaClckURL :: ClckURL -> [(T.Text, Maybe T.Text)] -> T.Text
}
type MediaT m = ClckT MediaURL (ReaderT MediaConfig m)
type MediaM = ClckT MediaURL (ReaderT MediaConfig (ServerPartT IO))
data MediaFormError
= MediaCFE (CommonFormError [Input])
deriving Show
instance FormError MediaFormError where
type ErrorInputType MediaFormError = [Input]
commonFormError = MediaCFE
instance (Functor m, Monad m) => EmbedAsChild (MediaT m) MediaFormError where
asChild e = asChild (show e)
type MediaForm = ClckFormT MediaFormError MediaM
instance (IsName n TL.Text) => EmbedAsAttr MediaM (Attr n MediaURL) where
asAttr (n := u) =
do url <- showURL u
asAttr $ MkAttr (toName n, pAttrVal (TL.fromStrict url))
instance (IsName n TL.Text) => EmbedAsAttr MediaM (Attr n ClckURL) where
asAttr (n := url) =
do showFn <- mediaClckURL <$> ask
asAttr $ MkAttr (toName n, pAttrVal (TL.fromStrict $ showFn url []))
runMediaT :: MediaConfig -> MediaT m a -> ClckT MediaURL m a
runMediaT mc m = mapClckT f m
where
f r = runReaderT r mc
instance (Monad m) => MonadReader MediaConfig (MediaT m) where
ask = ClckT $ ask
local f (ClckT m) = ClckT $ local f m
instance (Functor m, Monad m) => GetAcidState (MediaT m) MediaState where
getAcidState =
mediaState <$> ask
withMediaConfig :: Maybe FilePath -> FilePath -> (MediaConfig -> IO a) -> IO a
withMediaConfig mBasePath mediaDir f =
do let basePath = fromMaybe "_state" mBasePath
cacheDir = mediaDir </> "_cache"
createDirectoryIfMissing True cacheDir
bracket (openLocalStateFrom (basePath </> "media") initialMediaState) (createCheckpointAndClose) $ \media ->
bracket (startIOThread (applyTransforms mediaDir cacheDir)) killIOThread $ \ioThread ->
do magic <- magicOpen [MagicMime, MagicError]
magicLoadDefault magic
f (MediaConfig { mediaDirectory = mediaDir
, mediaState = media
, mediaMagic = magic
, mediaIOThread = ioThread
, mediaClckURL = undefined
})