yesod-goodies (empty) → 0.0.3
raw patch · 10 files changed
+638/−0 lines, 10 filesdep +HTTPdep +basedep +bytestringsetup-changed
Dependencies added: HTTP, base, bytestring, directory, old-locale, pandoc, pureMD5, text, time, yesod, yesod-form
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Yesod/Goodies.hs +43/−0
- Yesod/Goodies/Gravatar.hs +127/−0
- Yesod/Goodies/Links.hs +78/−0
- Yesod/Goodies/Markdown.hs +128/−0
- Yesod/Goodies/Search.hs +100/−0
- Yesod/Goodies/Shorten.hs +25/−0
- Yesod/Goodies/Time.hs +66/−0
- yesod-goodies.cabal +39/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Patrick Brisbin++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 Patrick Brisbin 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,2 @@+import Distribution.Simple+main = defaultMain
+ Yesod/Goodies.hs view
@@ -0,0 +1,43 @@+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- A collection of various small helpers that are general enough to be +-- useful in any yesod application.+--+-------------------------------------------------------------------------------+module Yesod.Goodies + ( + -- | Automatically lookup a gravatar img url by email+ module Yesod.Goodies.Gravatar++ -- | Create concise link widgets for use throughout your app+ , module Yesod.Goodies.Links++ -- | Useful wrappers around the pandoc library specific to markdown + -- manipulation+ , module Yesod.Goodies.Markdown++ -- | A simple framework for searching the data on your site+ , module Yesod.Goodies.Search++ -- | Shorten a variety of string-like types to a certian length and + -- add ellipsis+ , module Yesod.Goodies.Shorten++ -- | Print time values in human readable ways+ , module Yesod.Goodies.Time+ ) where++import Yesod.Goodies.Gravatar+import Yesod.Goodies.Links+import Yesod.Goodies.Markdown+import Yesod.Goodies.Search+import Yesod.Goodies.Shorten+import Yesod.Goodies.Time
+ Yesod/Goodies/Gravatar.hs view
@@ -0,0 +1,127 @@+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Gravatar+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- <http://en.gravatar.com/>.+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Gravatar+ ( + -- * Base request+ Email+ , gravatarImg++ -- * Options+ , GravatarOptions(..)+ , GravatarParam(..)+ , Size(..)+ , Default(..)+ , ForceDefault(..)+ , Rating(..)+ , defaultOptions++ ) where++import Data.Digest.Pure.MD5 (md5)+import Data.List (intercalate)+import Data.Maybe (catMaybes)+import Network.HTTP.Base (urlEncode)++import qualified Data.ByteString.Lazy.Char8 as C8+import qualified Data.Text as T++-- | This is @'Text'@ because yesod is moving towards using that type in +-- as many places as possible. It's what you should be storing in your +-- database and what "Yesod.Form" already gives you out of an input.+type Email = T.Text++class GravatarParam a where+ toParam :: a -> Maybe (String, String)++-- | Size in pixels+newtype Size = Size Int++instance GravatarParam Size where+ toParam (Size i) = Just ("s", show i)++-- | Always show the default image+newtype ForceDefault = ForceDefault Bool++instance GravatarParam ForceDefault where+ toParam (ForceDefault b) = if b then Just ("f", "y") else Nothing++-- | Image to show when an avatar is not available+data Default = Custom String -- ^ supply your own url+ | NotFound -- ^ do not load an image return a 404+ | MM -- ^ mystery man+ | Identicon -- ^ geometric pattern based on the hash+ | MonsterId -- ^ a generated monster+ | Wavatar -- ^ generated faces+ | Retro -- ^ gernated, 8-bit arcade style pixelated face++instance GravatarParam Default where+ toParam (Custom s) = Just ("d", urlEncode s)+ toParam NotFound = Just ("d", "404" )+ toParam MM = Just ("d", "mm" )+ toParam Identicon = Just ("d", "identicon")+ toParam MonsterId = Just ("d", "monsterid")+ toParam Wavatar = Just ("d", "wavatar" )+ toParam Retro = Just ("d", "retro" )++-- | Limit the returned images by rating+data Rating = G | PG | R | X++instance GravatarParam Rating where+ toParam G = Just ("r", "g" )+ toParam PG = Just ("r", "pg")+ toParam R = Just ("r", "r" )+ toParam X = Just ("r", "x" )++data GravatarOptions = GravatarOptions+ { gSize :: Maybe Size+ , gDefault :: Maybe Default+ , gForceDefault :: ForceDefault+ , gRating :: Maybe Rating+ }++defaultOptions :: GravatarOptions+defaultOptions = GravatarOptions+ { gSize = Nothing+ , gDefault = Nothing+ , gForceDefault = ForceDefault False+ , gRating = Nothing+ }++-- | Return the avatar for the given email using the provided options +gravatarImg :: Email -> GravatarOptions -> String+gravatarImg e opts = "http://www.gravatar.com/avatar/" ++ hashEmail e `addParams` opts++-- | <http://en.gravatar.com/site/implement/hash/>+hashEmail :: T.Text -> String+hashEmail = md5sum . T.toLower . T.strip++ where+ md5sum :: T.Text -> String+ md5sum = show . md5 . C8.pack . T.unpack++addParams :: String -> GravatarOptions -> String+addParams url opts = helper url . map (\(k,v) -> k ++ "=" ++ v)+ $ catMaybes [ fmap' toParam $ gSize opts+ , fmap' toParam $ gDefault opts+ , toParam $ gForceDefault opts+ , fmap' toParam $ gRating opts+ ]+ where+ helper :: String -> [String] -> String+ helper u [] = u+ helper u l = (++) u . (:) '?' $ intercalate "&" l++ fmap' :: (a -> Maybe b) -> Maybe a -> Maybe b+ fmap' _ Nothing = Nothing+ fmap' f (Just x) = f x
+ Yesod/Goodies/Links.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Links+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Links+ ( Destination(..)+ , Link(..)+ , YesodLinked(..)+ , IsLink(..)+ , link+ , link'+ ) where++import Yesod (GWidget, Route, hamlet)+import qualified Data.Text as T++-- | An internal route or external url+data Destination m = Internal (Route m) | External T.Text++-- | A link to a 'Destination' with supplied titles and text to be used +-- when showing the html.+data Link m = Link+ { linkDest :: Destination m+ , linkTitle :: T.Text+ , linkText :: T.Text+ }++-- | A type family class used to generalize widgets printing routes that +-- are internal to your site+--+-- > instance YesodLinked MySite where+-- > type Linked = MySite+--+class YesodLinked m where+ type Linked++-- | Any type can represent a link.+--+-- > instance IsLink MyAppRoute where+-- > toLink RootR = Link (Internal RootR) "go home" "home"+-- > toLink AboutR = Link (Internal AboutR) "about this site" "about"+-- > ...+-- >+-- > getRootR :: Handler RepHtml+-- > getRootR = defaultLayout $ do+-- > [hamlet|+-- >+-- > be sure to visit our ^{link AboutR} page.+-- >+-- > |]+--+class IsLink a where+ toLink :: a -> Link Linked++-- | Link to any @'IsLink'@ type. This is simply @'link'' . 'toLink'@.+link :: IsLink a => a -> GWidget s Linked ()+link = link' . toLink++-- | Link to a raw @'Link'@. Can be used even if your site is not an+-- instance of 'YesodLinked'.+link' :: Link m -> GWidget s m ()+#if __GLASGOW_HASKELL__ >= 700+link' (Link (Internal i) t x) = [hamlet|<a title="#{t}" href="@{i}">#{x}|]+link' (Link (External e) t x) = [hamlet|<a title="#{t}" href="#{e}">#{x}|]+#else+link' (Link (Internal i) t x) = [$hamlet|<a title="#{t}" href="@{i}">#{x}|]+link' (Link (External e) t x) = [$hamlet|<a title="#{t}" href="#{e}">#{x}|]+#endif
+ Yesod/Goodies/Markdown.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Markdown+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- Rewrite/simplification of yesod-markdown written by ajdunlap.+--+-- <https://github.com/ajdunlap/yesod-markdown>+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Markdown+ ( Markdown(..)+ -- * Conversions+ , parseMarkdown+ , writePandoc+ -- * Wrappers+ , markdownToHtml+ , markdownFromFile+ -- * Option sets+ , yesodDefaultWriterOptions+ , yesodDefaultParserState+ -- * Form helpers+ , markdownField+ , maybeMarkdownField+ )+ where+++import Yesod+import Yesod.Form.Core+import Yesod.Goodies.Shorten++import Text.Pandoc+import Text.Pandoc.Shared++import Data.Monoid (Monoid)+import Data.String (IsString)+import System.Directory (doesFileExist)++import qualified Data.Text as T++newtype Markdown = Markdown String+ deriving (Eq, Ord, Show, Read, PersistField, IsString, Monoid)++instance Shorten Markdown where+ shorten n (Markdown s) = Markdown $ shorten n s++instance ToFormField Markdown y where+ toFormField = markdownField++instance ToFormField (Maybe Markdown) y where+ toFormField = maybeMarkdownField++markdownField :: (IsForm f, FormType f ~ Markdown) => FormFieldSettings -> Maybe Markdown -> f+markdownField = requiredFieldHelper markdownFieldProfile++maybeMarkdownField :: FormFieldSettings -> FormletField sub y (Maybe Markdown)+maybeMarkdownField = optionalFieldHelper markdownFieldProfile++markdownFieldProfile :: FieldProfile sub y Markdown+markdownFieldProfile = FieldProfile+ { fpParse = Right . Markdown . unlines . lines' . T.unpack+ , fpRender = \(Markdown m) -> T.pack m+ , fpWidget = \theId name val _isReq -> addHamlet+#if __GLASGOW_HASKELL__ >= 700+ [hamlet|+#else+ [$hamlet|+#endif+ <textarea id="#{theId}" name="#{name}" .markdown>#{val}+ |]+ }++ where+ lines' :: String -> [String]+ lines' = map go . lines++ go [] = []+ go ('\r':xs) = go xs+ go (x:xs) = x : go xs++-- | Converts markdown directly to html using the yesod default option +-- sets+markdownToHtml :: Markdown -> Html+markdownToHtml = writePandoc yesodDefaultWriterOptions+ . parseMarkdown yesodDefaultParserState++-- | Reads markdown in from the specified file; returns the empty string +-- if the file does not exist+markdownFromFile :: FilePath -> IO Markdown+markdownFromFile f = do+ exists <- doesFileExist f+ content <- do+ if exists+ then readFile f+ else return ""++ return $ Markdown content++writePandoc :: WriterOptions -> Pandoc -> Html+writePandoc wo = preEscapedString . writeHtmlString wo++parseMarkdown :: ParserState -> Markdown -> Pandoc+parseMarkdown ro (Markdown m) = readMarkdown ro m++yesodDefaultWriterOptions :: WriterOptions+yesodDefaultWriterOptions = defaultWriterOptions+ { writerEmailObfuscation = JavascriptObfuscation+ , writerSectionDivs = False+ , writerWrapText = False+ }++yesodDefaultParserState :: ParserState+yesodDefaultParserState = defaultParserState+ { stateSmart = True+ , stateParseRaw = True+ }
+ Yesod/Goodies/Search.hs view
@@ -0,0 +1,100 @@+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Search+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Search+ ( SearchResult(..)+ , Search(..)+ , search+ , search_+ , weightedSearch+ , weightedSearch_+ -- * search helpers+ , TextSearch(..)+ , keywordMatch+ ) where++import Data.List (sortBy, intersect)+import Data.Ord (comparing)+import Data.Maybe (catMaybes)++import qualified Data.Text as T++-- | A ranked search result+data SearchResult a = SearchResult+ { searchRank :: Double+ , searchResult :: a+ }++-- | Any item can be searched by providing a @'match'@ function.+class Search a where+ -- | If two results have the same rank, optionally lend preference+ -- to one. The /greater/ value will appear first.+ preference :: SearchResult a -> SearchResult a -> Ordering+ preference _ _ = EQ++ -- | Given a search term and some @a@, provide @Just@ a ranked + -- result or @Nothing@.+ match :: T.Text -> a -> Maybe (SearchResult a)++-- | Excute a search on a list of @a@s and rank the results+search :: Search a => T.Text -> [a] -> [SearchResult a]+search t = rankResults . catMaybes . map (match t)++-- | Identical but discards the actual rank values.+search_ :: Search a => T.Text -> [a] -> [a]+search_ t = map searchResult . search t++-- | Add (or remove) weight from items that have certian properties.+weightedSearch :: Search a => (a -> Double) -> T.Text -> [a] -> [SearchResult a]+weightedSearch f t = rankResults . map (applyFactor f) . catMaybes . map (match t)++ where+ applyFactor :: (a -> Double) -> SearchResult a -> SearchResult a+ applyFactor f' (SearchResult d v) = SearchResult (d * f' v) v++weightedSearch_ :: Search a => (a -> Double) -> T.Text -> [a] -> [a]+weightedSearch_ f t = map searchResult . weightedSearch f t++-- | Reverse sort the results by rank and then preference.+rankResults :: Search a => [SearchResult a] -> [SearchResult a]+rankResults = reverse . sortBy (comparing searchRank `andthen` preference)++-- | Compare values in a compound way+--+-- > sortBy (comparing snd `andthen` comparing fst)+--+andthen :: (a -> a -> Ordering) -> (a -> a -> Ordering) -> a -> a -> Ordering+andthen f g a b =+ case f a b of+ EQ -> g a b+ x -> x++-- | Being a member of this class means defining the way to represent +-- your type as pure text so it can be searched by keyword, etc.+class TextSearch a where+ toText :: a -> T.Text++-- | Search term is interpreted as keywords. Results are ranked by the +-- number of words that appear in the source text, a rank of 0 returns +-- Nothing.+keywordMatch :: TextSearch a => T.Text -> a -> Maybe (SearchResult a)+keywordMatch t v = go $ fix (toText v) `intersect` fix t++ where+ go [] = Nothing+ go ms = Just $ SearchResult (fromIntegral $ length ms) v++ fix :: T.Text -> [T.Text]+ fix = filter (not . T.null)+ . map T.strip+ . T.words+ . T.toCaseFold+ . T.filter (`notElem` ",.-")
+ Yesod/Goodies/Shorten.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Shorten+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Shorten (Shorten(..)) where++import qualified Data.Text as T++class Shorten a where+ shorten :: Int -> a -> a++instance Shorten String where+ shorten n s = if length s > n then take (n - 3) s ++ "..." else s++instance Shorten T.Text where+ shorten n t = if T.length t > n then T.take (n - 3) t `T.append` "..." else t
+ Yesod/Goodies/Time.hs view
@@ -0,0 +1,66 @@+-------------------------------------------------------------------------------+-- |+-- Module : Yesod.Goodies.Time+-- Copyright : (c) Patrick Brisbin 2010 +-- License : as-is+--+-- Maintainer : pbrisbin@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-------------------------------------------------------------------------------+module Yesod.Goodies.Time+ ( humanReadableTime+ ) where++import Yesod+import Data.Time+import System.Locale++import Data.Char (isSpace)++-- | Based on @humanReadableTimeDiff@ found in+-- <https://github.com/snoyberg/haskellers/blob/master/Haskellers.hs>,+-- <https://github.com/snoyberg/haskellers/blob/master/LICENSE>+humanReadableTime :: UTCTime -> GHandler s m String+humanReadableTime t = return . helper . flip diffUTCTime t =<< liftIO getCurrentTime++ where+ minutes :: NominalDiffTime -> Double+ minutes n = realToFrac $ n / 60++ hours :: NominalDiffTime -> Double+ hours n = minutes n / 60++ days :: NominalDiffTime -> Double+ days n = hours n / 24++ weeks :: NominalDiffTime -> Double+ weeks n = days n / 7++ years :: NominalDiffTime -> Double+ years n = days n / 365++ i2s :: RealFrac a => a -> String+ i2s n = show m where m = truncate n :: Int++ trim = f . f where f = reverse . dropWhile isSpace++ old = utcToLocalTime utc t+ dow = trim $! formatTime defaultTimeLocale "%l:%M %p on %A" old+ thisYear = trim $! formatTime defaultTimeLocale "%b %e" old+ previousYears = trim $! formatTime defaultTimeLocale "%b %e, %Y" old++ helper d + | d < 1 = "just now"+ | d < 60 = i2s d ++ " seconds ago"+ | minutes d < 2 = "one minute ago"+ | minutes d < 60 = i2s (minutes d) ++ " minutes ago"+ | hours d < 2 = "one hour ago"+ | hours d < 24 = "about " ++ i2s (hours d) ++ " hours ago"+ | days d < 5 = "at " ++ dow+ | days d < 10 = i2s (days d) ++ " days ago"+ | weeks d < 2 = i2s (weeks d) ++ " week ago"+ | weeks d < 5 = i2s (weeks d) ++ " weeks ago"+ | years d < 1 = "on " ++ thisYear+ | otherwise = "on " ++ previousYears
+ yesod-goodies.cabal view
@@ -0,0 +1,39 @@+name: yesod-goodies+version: 0.0.3+description: A collection of various small helpers useful in any yesod application.+synopsis: A collection of various small helpers useful in any yesod application.+homepage: http://github.com/pbrisbin/yesod-goodies+license: BSD3+license-file: LICENSE+author: Patrick Brisbin+maintainer: me@pbrisbin.com+category: Web, Yesod+build-type: Simple+cabal-version: >=1.6++library+ exposed-modules: Yesod.Goodies+ , Yesod.Goodies.Gravatar+ , Yesod.Goodies.Links+ , Yesod.Goodies.Markdown+ , Yesod.Goodies.Search+ , Yesod.Goodies.Shorten+ , Yesod.Goodies.Time++ build-depends: base >= 4 && < 5+ , text >= 0.11 && < 0.12+ , bytestring >= 0.9.1 && < 10.0+ , pandoc >= 1.8.1 && < 1.9+ , yesod >= 0.8 && < 0.9+ , yesod-form >= 0.1 && < 0.2+ , pureMD5 < 3+ , HTTP+ , directory+ , time+ , old-locale++ ghc-options: -Wall+ +source-repository head+ type: git+ location: git://github.com/pbrisbin/yesod-goodies.git