packages feed

clckwrks-plugin-media (empty) → 0.3.0

raw patch · 17 files changed

+720/−0 lines, 17 filesdep +acid-statedep +attoparsecdep +basebuild-type:Customsetup-changed

Dependencies added: acid-state, attoparsec, base, blaze-html, clckwrks, containers, directory, filepath, gd, happstack-server, hsp, ixset, magic, mtl, reform, reform-happstack, reform-hsp, safecopy, text, web-plugins, web-routes, web-routes-th

Files

+ Clckwrks/Media.hs view
@@ -0,0 +1,11 @@+module Clckwrks.Media +   ( module Clckwrks.Media.URL+   , module Clckwrks.Media.Monad+   , module Clckwrks.Media.Route+   , module Clckwrks.Media.Types+   ) where++import Clckwrks.Media.URL+import Clckwrks.Media.Monad+import Clckwrks.Media.Route+import Clckwrks.Media.Types
+ Clckwrks/Media/Acid.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, TypeFamilies #-}+module Clckwrks.Media.Acid where++import Control.Monad.Reader   (ask)+import Control.Monad.State    (get, put)+import Data.Acid              (Query, Update, makeAcidic)+import Data.IxSet             (IxSet, (@=), getOne, empty, toList, updateIx)+import Data.SafeCopy          (base, deriveSafeCopy)+import Clckwrks.Media.Types   (Medium(..), MediumId(..))++data MediaState = MediaState +    { nextMediumId :: MediumId+    , media        :: IxSet Medium+    }+$(deriveSafeCopy 0 'base ''MediaState)++initialMediaState :: MediaState+initialMediaState = MediaState+    { nextMediumId = MediumId 0+    , media        = empty+    }++-- | get the next unused 'MediaId'+genMediumId :: Update MediaState MediumId+genMediumId =+    do ms@MediaState{..} <- get+       put $ ms { nextMediumId = MediumId $ succ $ unMediumId $ nextMediumId }+       return nextMediumId++-- | get 'Media' by 'MediumId'+getMediumById :: MediumId -> Query MediaState (Maybe Medium)+getMediumById mid =+    do MediaState{..} <- ask+       return $ getOne (media @= mid)++-- | store 'Media' in the state. Will overwrite an existing entry with the same 'MediumId'+putMedium :: Medium -> Update MediaState ()+putMedium m =+    do ms@MediaState{..} <- get+       put $ ms { media = updateIx (mediumId m) m media }++allMediumIds :: Query MediaState [MediumId]+allMediumIds =+    do MediaState{..} <- ask+       return $ map mediumId (toList media)++$(makeAcidic ''MediaState +   [ 'genMediumId+   , 'getMediumById+   , 'putMedium+   , 'allMediumIds+   ]+ )
+ Clckwrks/Media/Monad.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, TypeSynonymInstances, OverloadedStrings #-}+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 Happstack.Server+import Happstack.Server.Internal.Monads (FilterFun)+import HSP                  (Attr((:=)), Attribute(MkAttr), EmbedAsAttr(..), EmbedAsChild(..), IsName(toName), pAttrVal)+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 -- ^ directory in which to store uploaded media files+    , 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) => EmbedAsAttr MediaM (Attr n MediaURL) where+        asAttr (n := u) =+            do url <- showURL u+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack url))++instance (IsName n) => EmbedAsAttr MediaM (Attr n ClckURL) where+        asAttr (n := url) =+            do showFn <- mediaClckURL <$> ask+               asAttr $ MkAttr (toName n, pAttrVal (T.unpack $ 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+                             })
+ Clckwrks/Media/Page/AllMedia.hs view
@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Media.Page.AllMedia where++import Control.Applicative     ((<$>))+import Control.Monad.Reader    (ask)+import Clckwrks                (ClckURL(..), query)+import Clckwrks.Admin.Template (template)+import Clckwrks.Media.Acid     (AllMediumIds(..))+import Clckwrks.Media.Types    (MediumId(..))+import Clckwrks.Media.Monad    (MediaM)+import Clckwrks.Media.URL      (MediaURL(..))+import Data.String             (fromString)+import Happstack.Server        (Response, asContentType, notFound, serveFile, toResponse)+import HSP ++allMedia :: MediaM Response+allMedia =+    do mediumIds <- query AllMediumIds+       template "all  media" <link rel="stylesheet" type="text/css" href=(PluginData (fromString "media") "style.css") /> $ +                mkGallery mediumIds++mkGallery :: [MediumId] -> XMLGenT MediaM XML+mkGallery mediumIds =+    <ul id="media-gallery">+      <% mapM mkPreview mediumIds %>+    </ul>++mkPreview :: MediumId -> XMLGenT MediaM XML+mkPreview mid =+       <li>+        <a href=(GetMedium mid)><img src=(Preview mid) /></a>+       </li>
+ Clckwrks/Media/Page/GetMedium.hs view
@@ -0,0 +1,20 @@+module Clckwrks.Media.Page.GetMedium where++import Control.Applicative  ((<$>))+import Control.Monad.Reader (ask)+import Clckwrks             (query)+import Clckwrks.Media.Acid  (GetMediumById(..))+import Clckwrks.Media.Types (MediumId(..), Medium(..), mediumContentType)+import Clckwrks.Media.Monad (MediaM, MediaConfig(..))+import Happstack.Server     (Response, asContentType, notFound, serveFile, toResponse)+import System.FilePath      ((</>))++getMedium :: MediumId -> MediaM Response+getMedium mid =+    do mMedium <- query (GetMediumById mid)+       case mMedium of+         Nothing -> do notFound $ toResponse $ "Invalid medium id " ++ show (unMediumId mid)+         (Just medium) ->+             do md <- mediaDirectory <$> ask+                serveFile (asContentType (mediumContentType $ mediumKind medium)) (md </> (mediumPath medium))+
+ Clckwrks/Media/Page/Preview.hs view
@@ -0,0 +1,35 @@+module Clckwrks.Media.Page.Preview where++import Control.Monad.Reader+import Control.Monad.Trans+import Clckwrks+import Clckwrks.IOThread+import Clckwrks.Media.Acid+import Clckwrks.Media.Monad+import Clckwrks.Media.Types+import Happstack.Server++previewMedium :: MediumId -> MediaM Response+previewMedium mid =+    do size <- lookSize <|> pure Tall+       mFp <- previewMediumFilePath mid size+       case mFp of +         Nothing -> notFound $ toResponse $ "Invalid MediumId " ++ show (unMediumId mid)+         (Just fp) -> serveFile (guessContentTypeM mimeTypes) fp++lookSize :: MediaM PreviewSize+lookSize =+    do txt <- look "size"+       case txt of+         "tall"   -> return Tall+         "grande" -> return Grande+         "venti"  -> return Venti+         _        -> mzero++previewMediumFilePath :: MediumId -> PreviewSize -> MediaM (Maybe FilePath)+previewMediumFilePath mediumId size =+    do filterChan <- mediaIOThread <$> ask+       res <- query (GetMediumById mediumId)+       case res of+         Nothing -> return Nothing+         (Just medium) -> Just <$> (liftIO (ioRequest filterChan (medium, size)))
+ Clckwrks/Media/Page/Upload.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Clckwrks.Media.Page.Upload where++import Control.Applicative  ((<$>), (<*))+import Control.Monad.Reader (ReaderT, ask)+import Control.Monad.Trans  (liftIO)+import Clckwrks             (ClckT, ClckFormT, update, seeOtherURL)+import Clckwrks.Admin.Template (template)+import Clckwrks.Media.Acid  (GenMediumId(..), PutMedium(..))+import Clckwrks.Media.Monad (MediaConfig(..), MediaM, MediaForm)+import Clckwrks.Media.Types (Medium(..), MediumId(..), MediumKind(..))+import Clckwrks.Media.URL   (MediaURL(..))+import           Data.Map   (Map)+import qualified Data.Map   as Map+import Data.Text            (pack)+import Happstack.Server     (ContentType, Input, Response, ServerPartT, ok, setResponseCode, toResponse)+import HSP+import Magic                (magicFile)+import Text.Reform          ((++>), FormError(..))+import Text.Reform.Happstack (reform)+import Text.Reform.HSP.Text (inputFile, label, inputSubmit, textarea, fieldset, ol, li, form)+import System.Directory (copyFile)+import System.FilePath  ((</>), addExtension, takeExtension)+import Web.Routes (showURL)++extensionMap :: Map String (String, MediumKind)+extensionMap =+    Map.fromList+           [ ("image/jpeg", ("jpg", JPEG))+           ]++acceptedTypes :: [String]+acceptedTypes = Map.keys extensionMap++contentTypeExtension :: String -> Maybe (String, MediumKind)+contentTypeExtension ct = Map.lookup (takeWhile (/= ';') ct) extensionMap++uploadMedium :: MediaURL -> MediaM Response+uploadMedium here =+    do template "Upload Medium" () $+        <%>+         <% reform (form here) "ep" saveMedium Nothing uploadForm %>+        </%>++    where+      saveMedium :: (String, FilePath, ContentType) -> MediaM Response+      saveMedium (tempPath, origName, contentType) =+          do md    <- mediaDirectory <$> ask+             magic <- mediaMagic <$> ask+             contentType <- liftIO $ magicFile magic tempPath+             case contentTypeExtension contentType of+                Nothing ->+                    do setResponseCode 415+                       template "Unsupported Type" () $+                           <%>+                            <h1>Unsupported Type</h1>+                            <p>The file you uploaded appears to have the content type <b><% contentType %></b>. However, at this time the only supported types are <b><% acceptedTypes %></b>.</p>+                           </%>+                (Just (ext, kind)) ->+                    do -- renameFile would be faster, but may not work if it has to cross physical devices+                       -- in theory, the filename could be the md5sum of the file making it easy to check for corruption+                       mid@(MediumId i) <- update GenMediumId+                       let destPath = show i `addExtension` ext+                       liftIO $ copyFile tempPath (md </> destPath)+                       let medium = Medium { mediumId   = mid+                                           , uploadName = origName+                                           , mediumPath = destPath+                                           , mediumKind = kind+                                           }+                       update (PutMedium medium)+                       seeOtherURL (GetMedium mid)++uploadForm :: MediaForm (FilePath, FilePath, ContentType)+uploadForm =+    label "upload file: " ++> inputFile <* inputSubmit (pack "Upload")
+ Clckwrks/Media/Plugin.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE RecordWildCards, FlexibleContexts, OverloadedStrings #-}+module Clckwrks.Media.Plugin where++import Clckwrks+import Clckwrks.IOThread         (IOThread(..), startIOThread, killIOThread)+import Clckwrks.Plugin           (clckPlugin)+import Clckwrks.Media.Acid       (initialMediaState)+import Clckwrks.Media.Monad      (MediaConfig(..), runMediaT)+import Clckwrks.Media.PreProcess (mediaCmd)+import Clckwrks.Media.Preview    (applyTransforms)+import Clckwrks.Media.Route      (routeMedia)+import Clckwrks.Media.URL        (MediaURL(..), MediaAdminURL(..))+import Control.Concurrent        (ThreadId, killThread)+import Control.Monad.State       (get)+import Data.Acid                 as Acid+import Data.Acid.Local           (createCheckpointAndClose, openLocalStateFrom)+import Data.Text                 (Text)+import qualified Data.Text.Lazy  as TL+import Data.Maybe                (fromMaybe)+import Data.Set                  (Set)+import Magic                     (Magic, MagicFlag(..), magicLoadDefault, magicOpen)+import System.Directory          (createDirectoryIfMissing)+import System.FilePath           ((</>))+import Web.Plugins.Core          (Plugin(..), Plugins(..), When(..), addCleanup, addHandler, initPlugin, getConfig, getPluginRouteFn)++mediaHandler :: (MediaURL -> [(Text, Maybe Text)] -> Text)+              -> MediaConfig+              -> ClckPlugins+              -> [Text]+              -> ClckT ClckURL (ServerPartT IO) Response+mediaHandler showMediaURL mediaConfig plugins paths =+    case parseSegments fromPathSegments paths of+      (Left e)  -> notFound $ toResponse (show e)+      (Right u) ->+          ClckT $ withRouteT flattenURL $ unClckT $ runMediaT mediaConfig $ routeMedia u+    where+      flattenURL ::   ((url' -> [(Text, Maybe Text)] -> Text) -> (MediaURL -> [(Text, Maybe Text)] -> Text))+      flattenURL _ u p = showMediaURL u p++mediaInit :: ClckPlugins+           -> IO (Maybe Text)+mediaInit plugins =+    do (Just mediaShowFn) <- getPluginRouteFn plugins (pluginName mediaPlugin)+       (Just clckShowFn) <- getPluginRouteFn plugins (pluginName clckPlugin)+       mTopDir <- clckTopDir <$> getConfig plugins+       let basePath = maybe "_state" (\td -> td </> "_state") mTopDir -- FIXME+           mediaDir = maybe "_media" (\td -> td </> "_media") mTopDir+           cacheDir = mediaDir </> "_cache"+       createDirectoryIfMissing True cacheDir++       acid <- openLocalStateFrom (basePath </> "media") initialMediaState+       addCleanup plugins Always (createCheckpointAndClose acid)++       ioThread <- startIOThread (applyTransforms mediaDir cacheDir)+       addCleanup plugins Always (killIOThread ioThread)++       magic <- magicOpen [MagicMime, MagicError]+       magicLoadDefault magic++       let mediaConfig = MediaConfig { mediaDirectory = mediaDir+                                     , mediaState     = acid+                                     , mediaMagic     = magic+                                     , mediaIOThread  = ioThread+                                     , mediaClckURL   = clckShowFn+                                     }++       addPreProc plugins (mediaCmd mediaShowFn)+       addHandler plugins (pluginName mediaPlugin) (mediaHandler mediaShowFn mediaConfig)++       return Nothing++addMediaAdminMenu :: ClckT url IO ()+addMediaAdminMenu =+    do p <- plugins <$> get+       (Just mediaShowURL) <- getPluginRouteFn p (pluginName mediaPlugin)+       let uploadURL   = mediaShowURL (MediaAdmin Upload) []+           allMediaURL = mediaShowURL (MediaAdmin AllMedia) []+       addAdminMenu ("Media Gallery", [("Upload",    uploadURL)+                                      ,("All Media", allMediaURL)+                                      ])++mediaPlugin :: Plugin MediaURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig [TL.Text -> ClckT ClckURL IO TL.Text]+mediaPlugin = Plugin+    { pluginName       = "media"+    , pluginInit       = mediaInit+    , pluginDepends    = []+    , pluginToPathInfo = toPathInfo+    , pluginPostHook   = addMediaAdminMenu+    }++plugin :: ClckPlugins -- ^ plugins+       -> Text        -- ^ baseURI+       -> IO (Maybe Text)+plugin plugins baseURI =+    initPlugin plugins baseURI mediaPlugin+
+ Clckwrks/Media/PreProcess.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Clckwrks.Media.PreProcess where+import Control.Monad.Trans+import Control.Applicative+import Clckwrks (ClckT, ClckState)+import Clckwrks.Media.URL+import Clckwrks.Media.Types (MediumId(..))+import Clckwrks.Monad                   (transform, segments)+import Data.Attoparsec.Text.Lazy        (Parser, Result(..), char, choice, decimal, parse, skipMany, space, stringCI, skipMany)+import           Data.Text (Text)+import qualified Data.Text.Lazy         as TL+import           Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as B+import           Text.Blaze.Html ((!), toValue)+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Web.Routes (showURL)++parseAttr :: Text -> Parser ()+parseAttr name =+    do skipMany space+       stringCI name+       skipMany space+       char '='+       skipMany space++width :: Parser H.Attribute+width =+    A.width . H.toValue <$> (parseAttr "width" *> (decimal :: Parser Integer))++height :: Parser H.Attribute+height =+    A.height . H.toValue <$> (parseAttr "height" *> (decimal :: Parser Integer))++parseCmd :: Parser (MediumId, [H.Attribute])+parseCmd =+    (,) <$> (parseAttr "id" *> (MediumId <$> decimal))+        <*> (many $ choice [ width, height ])++mediaCmd :: (Monad m) =>+            (MediaURL -> [(Text, Maybe Text)] -> Text)+         -> TL.Text+         -> ClckT url m TL.Text+mediaCmd mediaShowURL txt =+    case parse (segments "media" parseCmd) txt of+      (Fail _ _ e) -> return (TL.pack e)+      (Done _ segments) ->+          do b <- transform (applyCmd mediaShowURL) segments+             return $ B.toLazyText b++applyCmd mediaShowURL (mid, attrs) =+    do let u = toValue $ mediaShowURL (GetMedium mid) []+       return $ B.fromLazyText $ renderHtml $ foldr (\attr tag -> tag ! attr) H.img (A.src u : attrs)
+ Clckwrks/Media/Preview.hs view
@@ -0,0 +1,44 @@+module Clckwrks.Media.Preview where++import Control.Applicative ((<$>))+import Control.Monad (unless)+import Control.Monad.Reader (ask)+import Control.Monad.Trans (liftIO)+import Clckwrks (query)+import Clckwrks.IOThread (ioRequest)+import Clckwrks.Media.Acid (GetMediumById(..))+import Clckwrks.Media.Types (Medium(..), MediumId(..), MediumKind(..), PreviewSize(..))++import Graphics.GD (imageSize, loadJpegFile, resizeImage, saveJpegFile, withImage)+import qualified Graphics.GD as GD+import System.Directory (doesFileExist)+import System.FilePath ((</>), splitExtension)++jpgThumbnail :: PreviewSize -> FilePath -> FilePath -> IO ()+jpgThumbnail size inPath outPath =+    withImage (loadJpegFile inPath) $ \image ->+        do (w,h) <- imageSize image+           let (w', h') =+                 if w > h+                 then (maxWidth, (h * maxWidth) `div` w)+                 else ((w * maxHeight) `div` h, maxHeight)+           image' <- resizeImage w' h' image+           saveJpegFile 60 outPath image'+    where+      maxWidth  = case size of+                    Tall   -> 200+                    Grande -> 300+                    Venti  -> 400+      maxHeight = maxWidth++mkThumbnail :: MediumKind -> PreviewSize -> FilePath -> FilePath -> IO ()+mkThumbnail JPEG = jpgThumbnail++applyTransforms :: FilePath -> FilePath -> (Medium, PreviewSize) -> IO FilePath+applyTransforms storageDir cacheDir (medium, size) =+    let origFP      = storageDir </> (mediumPath medium)+        (name, ext) = splitExtension (mediumPath medium)+        thumbFP     = cacheDir </> name ++ "_" ++ (show size) ++ ext+    in do e <- doesFileExist thumbFP+          unless e (mkThumbnail (mediumKind medium) size origFP thumbFP)+          return thumbFP
+ Clckwrks/Media/Route.hs view
@@ -0,0 +1,33 @@+module Clckwrks.Media.Route where++import Control.Applicative           ((<$>))+import Control.Monad.Reader          (ask)+import Clckwrks                      (Clck, Role(..), requiresRole_)+import Clckwrks.Media.Monad          (MediaM, MediaConfig(..))+import Clckwrks.Media.URL            (MediaURL(..), MediaAdminURL(..))+import Clckwrks.Media.Page.AllMedia  (allMedia)+import Clckwrks.Media.Page.GetMedium (getMedium)+import Clckwrks.Media.Page.Preview   (previewMedium)+import Clckwrks.Media.Page.Upload    (uploadMedium)+import qualified Data.Set            as Set+import Happstack.Server              (Response)+import Magic+-- import Paths_clckwrks_plugin_media (getDataDir)++checkAuth :: MediaURL -> MediaM MediaURL+checkAuth url =+    case url of+      MediaAdmin {} ->+          do showFn <- mediaClckURL <$> ask+             requiresRole_ showFn (Set.singleton Administrator) url+      _ -> return url+++routeMedia :: MediaURL -> MediaM Response+routeMedia unsecureURL =+    do url <- checkAuth unsecureURL+       case url of+         (MediaAdmin Upload)   -> uploadMedium url+         (MediaAdmin AllMedia) -> allMedia+         (GetMedium mid)       -> getMedium mid+         (Preview mid)         -> previewMedium mid
+ Clckwrks/Media/Types.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell #-}+module Clckwrks.Media.Types where++import Data.Data (Data, Typeable)+import Data.IxSet (Indexable(..), ixSet, ixFun)+import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)+import Data.Text     (Text)+import Web.Routes    (PathInfo(..))++newtype MediumId = MediumId { unMediumId :: Integer }+    deriving (Eq, Ord, Read, Show, Data, Typeable, SafeCopy, PathInfo)++data MediumKind+    = JPEG+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''MediumKind)++mediumContentType :: MediumKind -> String+mediumContentType JPEG = "image/jpeg; charset=binary"++data Medium+    = Medium { mediumId     :: MediumId+             , uploadName   :: FilePath+             , mediumPath   :: FilePath+             , mediumKind   :: MediumKind+             -- , fileSize    :: Integer+             }+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''Medium)++data PreviewSize+    = Tall+    | Grande+    | Venti+      deriving (Eq, Ord, Read, Show, Data, Typeable)+$(deriveSafeCopy 0 'base ''PreviewSize)++instance Indexable Medium where+    empty = ixSet [ ixFun ((:[]) . mediumId)+                  ]
+ Clckwrks/Media/URL.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}+module Clckwrks.Media.URL where++import Clckwrks.Media.Types (MediumId(..))+import Data.Data            (Data, Typeable)+import Web.Routes.TH        (derivePathInfo)++data MediaAdminURL+    = Upload+    | AllMedia+    deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''MediaAdminURL)++data MediaURL+    = GetMedium MediumId+    | Preview MediumId+    | MediaAdmin MediaAdminURL+    deriving (Eq, Ord, Read, Show, Data, Typeable)+$(derivePathInfo ''MediaURL)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Jeremy Shaw, SeeReason Partners LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jeremy Shaw nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,13 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple+import Distribution.Simple.Program++trhsxProgram = simpleProgram "trhsx"++main :: IO ()+main = defaultMainWithHooks simpleUserHooks {+         hookedPrograms = [trhsxProgram]+       }
+ clckwrks-plugin-media.cabal view
@@ -0,0 +1,64 @@+Name:                clckwrks-plugin-media+Version:             0.3.0+Synopsis:            media plugin for clckwrks+Homepage:            http://clckwrks.com/+License:             BSD3+License-file:        LICENSE+Author:              Jeremy Shaw+Maintainer:          Jeremy Shaw <jeremy@n-heptane.com>+Copyright:           2012 Jeremy Shaw, SeeReason Partners LLC+Category:            Clckwrks+Build-type:          Custom+Cabal-version:       >=1.6+Data-Files:+    data/style.css++source-repository head+    type:     darcs+    subdir:   clckwrks-plugin-media+    location: http://hub.darcs.net/stepcut/clckwrks++Library+  Build-tools:+    trhsx++  Exposed-modules:+    Clckwrks.Media+    Clckwrks.Media.Acid+    Clckwrks.Media.Monad+    Clckwrks.Media.Page.AllMedia+    Clckwrks.Media.Page.GetMedium+    Clckwrks.Media.Page.Preview+    Clckwrks.Media.Page.Upload+    Clckwrks.Media.Plugin+    Clckwrks.Media.PreProcess+    Clckwrks.Media.Preview+    Clckwrks.Media.Route+    Clckwrks.Media.Types+    Clckwrks.Media.URL+    Paths_clckwrks_plugin_media++  Build-depends:+    base                    < 5,+    acid-state             >= 0.7,+    attoparsec             == 0.10.*,+    blaze-html             == 0.5.*,+    clckwrks               == 0.13.*,+    containers             >= 0.4 && < 0.6,+    directory              >= 1.1 && < 1.3,+    filepath               >= 1.2 && < 1.4,+    gd                     == 3000.*,+    happstack-server       >= 7.0 && < 7.2,+    hsp                    == 0.7.*,+    ixset                  == 1.0.*,+    magic                  == 1.0.*,+    mtl                    >= 2.0 && < 2.3,+    reform                 == 0.1.*,+    reform-happstack       == 0.1.*,+    reform-hsp             >= 0.1.1 && < 0.2,+    safecopy               >= 0.6,+    text                   == 0.11.*,+    web-plugins            == 0.1.*,+    web-routes             == 0.27.*,+    web-routes-th          >= 0.21+
+ data/style.css view
@@ -0,0 +1,10 @@+ul#media-gallery+{+    list-style-type: none;+}++#media-gallery li+{+    display: inline;+    padding-right: 1em;+}