mime-directory (empty) → 0.1
raw patch · 4 files changed
+443/−0 lines, 4 filesdep +basedep +bytestringdep +old-localesetup-changed
Dependencies added: base, bytestring, old-locale, regex-pcre, time
Files
- Codec/MIME/ContentType/Text/Directory.hs +254/−0
- LICENSE +165/−0
- Setup.lhs +3/−0
- mime-directory.cabal +21/−0
+ Codec/MIME/ContentType/Text/Directory.hs view
@@ -0,0 +1,254 @@+module Codec.MIME.ContentType.Text.Directory+ ( Directory, Property(..), Type(..), Parameter(..), Value(..)+ , Rfc2425Types+ , ValueParser+ , nakedType, (@@)+ , parseDirectory+ , pa_URI, pa_text, pa_date, pa_time, pa_dateTime+ , pa_integer, pa_bool, pa_float, pa_textList+ , many+ , printDirectory+ , printProperty) where++import Data.Time+import System.Locale+import Data.Char (toLower)+import Data.Maybe (fromJust)+import Text.Regex.PCRE.ByteString.Lazy+import qualified Data.ByteString.Lazy.Char8 as B+import System.IO.Unsafe+++type Directory u = [Property u]++data Property u = Prop+ { prop_type :: Type+ , prop_parameters :: [Parameter]+ , prop_value :: Value u }+ deriving Show++data Type = Type+ { type_group :: Maybe B.ByteString+ , type_name :: B.ByteString }+ deriving Show++instance Eq Type where+ x == y = let f = B.map toLower . type_name+ in f x == f y++-- | Make a property type without any grouping.+nakedType :: B.ByteString -> Type+nakedType name = Type { type_group = Nothing, type_name = name }++-- | Check whether the given property is an instance of the given type.+(@@) :: Property u -> B.ByteString -> Bool+prop @@ name = prop_type prop == nakedType name++instance Ord Type where+ compare x y = let f = B.map toLower . type_name+ in compare (f x) (f y)++data Parameter = Param+ { param_name :: B.ByteString+ , param_value :: B.ByteString }+ deriving Show++type URI = B.ByteString++data Value u = URI URI+ | Text B.ByteString+ | Date Day+ | Time DiffTime+ | DateTime UTCTime+ | Integer Integer+ | Boolean Bool+ | Float Float+-- Decode a list of values as a list of properties, since rfc2425+-- considers them to be semantically equivalent.+-- | List (Value u)+ | IANAValue u -- an IANA defined type not part of rfc2425+ deriving (Eq, Show)++-- | Instantiate Value with this phantom type to indicate that property types+-- should be none other than those defined in rfc2425.+data Rfc2425Types++instance Show Rfc2425Types where+ show _ = undefined++-- | The type of parsers for property values, for instance to read an integer+-- property, text property, etc.+type ValueParser u = (Type, [Parameter]) -> B.ByteString -> [Value u]++-- | Break the input into logical lines, unfolding lines that span multiple+-- physical lines.+unfoldLines :: B.ByteString -> [B.ByteString]+unfoldLines "" = []+unfoldLines s = B.foldr f [B.empty] s+ where f '\r' (xs:xss) | Just (h1, xs') <- B.uncons xs,+ Just (h2, xs'') <- B.uncons xs' =+ case (h1, h2) of+ ('\n', ' ') -> xs'':xss+ ('\n', '\t') -> xs'':xss+ ('\n', _) -> "":xs':xss+ _ -> error "Malformed input: no LF after a CR."+ | otherwise = "":xss+ f x (xs:xss) = B.cons x xs : xss++newtype P a = P { unP :: B.ByteString -> (a, B.ByteString) }++instance Monad P where+ return x = P $ \s -> (x, s)+ m >>= k = P $ \s -> let (a, s') = unP m s in unP (k a) s'++p :: B.ByteString -- ^ Text of the regular expression.+ -> P B.ByteString -- ^ The matching part of the input.+p pat = P $ \s -> unsafePerformIO $ do+ Right r <- compile compUngreedy execAnchored pat+ Right result <- regexec r s+ return $ case result of+ Just (_, match, s', _) -> (match, s')+ Nothing -> error $ "Parse error: " ++ show (B.unpack s)++capture :: B.ByteString -- ^ Text of the regular expression containing capturing groups.+ -> P [B.ByteString] -- ^ The captured subparts of the input.+capture pat = P $ \s -> unsafePerformIO $ do+ Right r <- compile compUngreedy execAnchored pat+ Right result <- regexec r s+ return $ case result of+ Just (_, _, s', captures) -> (captures, s')+ Nothing -> error $ "Parse error: " ++ show (B.unpack s)++parseDirectory :: ValueParser u+ -- ^ Given a Property Type and a list of parameters,+ -- parse a string representation into a Value.+ -> B.ByteString+ -> Directory u+parseDirectory valparse = concatMap (fst . unP (pa_property valparse)) . unfoldLines++-- | Pa_ a string representation into a property. Note that the+-- return type here is actually a list of properties, because we+-- desugar properties whose values are lists into a list of+-- properties, one for each element of the value list.+pa_property :: ValueParser u+ -- ^ Given a Property Type and a list of parameters,+ -- parse a string representation into a (list of) Value.+ -> P [Property u]+pa_property valparse = do+ [groupt, typt, sept] <- capture "(?:((?:[[:alnum:]]|-)+).)?((?:[[:alnum:]]|-)+)(:|;)"+ params <- case B.unpack sept of+ ";" -> pa_parameterList+ ":" -> return []+ rest <- p ".*$"+ let group = if B.null groupt then Nothing else Just groupt+ let typ = Type { type_group = group, type_name = typt }+ prop v = Prop { prop_type = typ+ , prop_parameters = params+ , prop_value = v }+ return $ map prop $ valparse (typ, params) rest++pa_parameterList :: P [Parameter]+pa_parameterList = do+ [name, val, qval, sep] <- capture "((?:[[:alnum:]]|-)+)=(?:([^;:,\"]*)|\"([^\"]*)\")(,|:)"+ ps <- case sep of+ "," -> pa_parameterList+ ":" -> return []+ let value = if B.null val then qval else val+ return $ Param { param_name = name, param_value = value } : ps++-- A few canned parsers for value types defined in rfc2425++pa_URI :: ValueParser u+pa_URI _ = (:[]) . Text++-- | Unescape slashes, newlines and commas.+pa_text :: ValueParser u+pa_text tps = take 1 . pa_textList tps++pa_date :: ValueParser u+pa_date _ =+ (:[]) . Date . readTime defaultTimeLocale (iso8601DateFormat Nothing) . B.unpack++pa_time :: ValueParser u+pa_time _ =+ (:[]) . Time . utctDayTime . readTime defaultTimeLocale "%T" . B.unpack++pa_dateTime :: ValueParser u+pa_dateTime _ =+ (:[]) . DateTime .+ readTime defaultTimeLocale (iso8601DateFormat (Just "T%T")) .+ B.unpack++pa_integer :: ValueParser u+pa_integer _ = (:[]) . Integer . fst . fromJust . B.readInteger++pa_bool :: ValueParser u+pa_bool _ "TRUE" = [Boolean True]+pa_bool _ "FALSE" = [Boolean False]+pa_bool _ _ = error "Not a valid boolean."++pa_float :: ValueParser u+pa_float _ = (:[]) . Float . read . B.unpack++pa_textList :: ValueParser u+pa_textList _ "" = []+pa_textList _ s = map (Text . B.pack . B.unpack) $ B.foldr f [B.empty] s+ where f ',' (xs:xss) = B.empty : xs : xss+ f '\\' ("":xs:xss) = B.cons ',' xs : xss+ f '\\' (xs:xss) | Just ('n',_) <- B.uncons xs = B.cons '\n' xs : xss+ f '\\' (xs:xss) | Just ('N',_) <- B.uncons xs = B.cons '\n' xs : xss+ f '\\' (xs:xss) | Just ('\\',_) <- B.uncons xs = B.cons '\\' xs : xss+ f x (xs:xss) = B.cons x xs : xss++-- | Take a parser for single values to a parser for a list of values. This+-- assumes that the separator between values is the "," character, and that+-- values do not contain commas themselves.+many :: ValueParser u -> ValueParser u+many pa tps input = map (head . pa tps) $ breakAll input+ where breakAll "" = []+ breakAll xs = ys : breakAll (B.drop 1 zs)+ where (ys, zs) = B.span (/= ',') xs++-- Printing++showBS :: Show a => a -> B.ByteString+showBS = B.pack . show++-- Pretty printing of values+class PrintValue a where+ printValue :: a -> B.ByteString++instance PrintValue u => PrintValue (Value u) where+ printValue (URI v) = showBS v+ printValue (Text v) = v+ printValue (Date v) = showBS v+ printValue (Time v) = showBS v+ printValue (DateTime v) = showBS v+ printValue (Integer v) = showBS v+ printValue (Boolean True) = "TRUE"+ printValue (Boolean False) = "FALSE"+ printValue (Float v) = showBS v+ printValue (IANAValue v) = printValue v++instance PrintValue Rfc2425Types where+ printValue _ = error "No other types in RFC 2425."++printDirectory :: PrintValue u => [Property u] -> B.ByteString+printDirectory props = B.intercalate "\r\n" $ map printProperty props++printProperty :: PrintValue u => Property u -> B.ByteString+printProperty prop =+ if null (prop_parameters prop)+ then B.concat [ printType (prop_type prop), ":"+ , printValue (prop_value prop) ]+ else B.concat [ printType (prop_type prop), ";"+ , B.concat $ map printParameter $ prop_parameters prop, ":"+ , printValue (prop_value prop) ]++printType :: Type -> B.ByteString+printType typ = case type_group typ of+ Just group -> B.concat [group, ".", type_name typ]+ Nothing -> type_name typ++printParameter :: Parameter -> B.ByteString+printParameter param = B.concat [param_name param, "=", param_value param]
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions. ++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version. ++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ mime-directory.cabal view
@@ -0,0 +1,21 @@+name: mime-directory+version: 0.1+author: Mathieu Boespflug+maintainer: Mathieu Boespflug <mboes@tweag.net>+homepage: http://code.haskell.org/~mboes/mime-directory.git+synopsis: A library for parsing/printing the text/directory mime type.+description:+ A library for parsing\/printing the text\/directory mime type.+category: Text+license: LGPL+license-file: LICENSE+copyright: (c) 2008. Mathieu Boespflug <mboes@tweag.net>+cabal-version: >= 1.2.0+build-type: Simple+tested-with: GHC == 6.10++library+ build-depends: base >= 3, bytestring >= 0.9, regex-pcre >= 0.94,+ old-locale, time >= 1.1+ extensions: OverloadedStrings, EmptyDataDecls, PatternGuards+ exposed-modules: Codec.MIME.ContentType.Text.Directory