packages feed

dataurl (empty) → 0.1.0.0

raw patch · 7 files changed

+239/−0 lines, 7 filesdep +HTFdep +attoparsecdep +basesetup-changed

Dependencies added: HTF, attoparsec, base, base64-bytestring, bytestring, dataurl, text

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Alexander Thiemann <mail@athiemann.net>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,28 @@+dataurl+=====++[![Build Status](https://travis-ci.org/agrafix/dataurl.svg)](https://travis-ci.org/agrafix/dataurl)+++## Intro+++Handle data-urls+++## Install++* From Source (cabal): `git clone https://github.com/agrafix/dataurl.git && cd dataurl && cabal install`+* From Source (stack): `git clone https://github.com/agrafix/dataurl.git && cd dataurl && stack build`+++## Misc++### Supported GHC Versions++* 7.10.2++### License++Released under the MIT license.+(c) 2015 Alexander Thiemann <mail@athiemann.net>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dataurl.cabal view
@@ -0,0 +1,47 @@+name:                dataurl+version:             0.1.0.0+synopsis:            Handle data-urls+description:         Please see README.md+homepage:            http://github.com/agrafix/dataurl#readme+license:             MIT+license-file:        LICENSE+author:              Alexander Thiemann <mail@athiemann.net>+maintainer:          Alexander Thiemann <mail@athiemann.net>+copyright:           (c) 2015 Alexander Thiemann <mail@athiemann.net>+category:            Web+build-type:          Simple+extra-source-files:+     README.md+cabal-version:       >=1.10+tested-with:         GHC==7.10.2++library+  hs-source-dirs:      src+  exposed-modules:     Web.DataUrl+  build-depends:+                base >= 4.7 && < 5,+                attoparsec >=0.12,+                bytestring >=0.10,+                base64-bytestring >=1.0,+                text >=1.2+  default-language:    Haskell2010++test-suite dataurl-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  other-modules:       Web.DataUrlTest+  build-depends:+                dataurl,+                HTF >= 0.12,+                base >= 4.7 && < 5,+                attoparsec >=0.12,+                bytestring >=0.10,+                base64-bytestring >=1.0,+                text >=1.2+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/agrafix/dataurl
+ src/Web/DataUrl.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}+module Web.DataUrl+    ( parseDataUrl+    , DataUrlEnc(..), DataUrl(..)+    )+where++import Control.Applicative+import Control.Monad+import Data.Attoparsec.Text+import Data.Char+import Data.Maybe+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Char8 as BSC+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++-- | Source encoding of the data url string+data DataUrlEnc+   = DataUrlEncB64+   | DataUrlEncUrl+    deriving (Show, Eq)++-- | A parsed data url+data DataUrl+   = DataUrl+   { du_contentType :: !T.Text+   , du_charset :: !(Maybe T.Text) -- todo: fully strict+   , du_sourceEncoding :: !DataUrlEnc+   , du_data :: !BS.ByteString+   } deriving (Show, Eq)++-- | Parse a data url string+parseDataUrl :: T.Text -> Either String DataUrl+parseDataUrl = parseOnly dataUrlP++dataUrlP :: Parser DataUrl+dataUrlP =+    do _ <- string "data:"+       mContentType <-+           optional $+           do ct <- fieldContent+              mCharSet <-+                  optional (string ";charset=" *> fieldContent)+              return (ct, mCharSet)+       isBase64 <-+           isJust <$>+           optional (string ";base64")+       _ <- char ','+       rawData <- takeWhile1 (const True)+       endOfInput+       decodedData <-+           if isBase64+           then case B64.decode (T.encodeUtf8 rawData) of+                  Left err -> fail err+                  Right val -> return val+           else case urlDecode (T.unpack rawData) of+                  Nothing -> fail "Invalid url encoded data"+                  Just val -> return (BSC.pack val)+       return+          DataUrl+          { du_contentType = maybe "text/plain" fst mContentType+          , du_charset = join $ fmap snd mContentType+          , du_sourceEncoding =+              if isBase64 then DataUrlEncB64 else DataUrlEncUrl+          , du_data = decodedData+          }+    where+      fieldContent =+          takeWhile1 (\c -> c /= ';' && c /= ',')++-- hacky piece straight of some internet site :-(+urlDecode :: String -> Maybe String+urlDecode [] = Just []+urlDecode ('%':xs) =+    case xs of+      (a:b:xss) ->+          liftM ((chr . read $ "0x" ++ [a,b]) :) $+          urlDecode xss+      _ -> Nothing+urlDecode ('+':xs) = liftM (' ' :) $ urlDecode xs+urlDecode (x:xs) = liftM (x :) $ urlDecode xs
+ test/Test.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import Test.Framework+import {-@ HTF_TESTS @-} Web.DataUrlTest++main :: IO ()+main = htfMain htf_importedTests
+ test/Web/DataUrlTest.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+module Web.DataUrlTest where++import Web.DataUrl++import Test.Framework+import qualified Data.ByteString.Base64 as B64+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++test_parseDataUrlUrlEnc :: IO ()+test_parseDataUrlUrlEnc =+    do x <- assertRight (parseDataUrl inputData)+       assertEqual expected x+    where+      expected =+          DataUrl+          { du_contentType = "text/plain"+          , du_charset = Nothing+          , du_sourceEncoding = DataUrlEncUrl+          , du_data = "A brief note"+          }+      inputData = "data:,A%20brief%20note"++test_parseDataUrlB64 :: IO ()+test_parseDataUrlB64 =+    do x <- assertRight (parseDataUrl inputData)+       assertEqual expected x+    where+      expected =+          DataUrl+          { du_contentType = "image/png"+          , du_charset = Nothing+          , du_sourceEncoding = DataUrlEncB64+          , du_data = B64.decodeLenient (T.encodeUtf8 inputB64)+          }+      inputB64 =+          T.concat+          [ "iVBORw0KGgoAAAANSUhEUgAAAAoAAAAKCAYAAACNMs+9AAAABGdBTUEAALGP"+          , "C/xhBQAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9YGARc5KB0XV+IA"+          , "AAAddEVYdENvbW1lbnQAQ3JlYXRlZCB3aXRoIFRoZSBHSU1Q72QlbgAAAF1J"+          , "REFUGNO9zL0NglAAxPEfdLTs4BZM4DIO4C7OwQg2JoQ9LE1exdlYvBBeZ7jq"+          , "ch9//q1uH4TLzw4d6+ErXMMcXuHWxId3KOETnnXXV6MJpcq2MLaI97CER3N0"+          , "vr4MkhoXe0rZigAAAABJRU5ErkJggg=="+          ]+      inputData =+          T.concat+          [ "data:image/png;base64,"+          , inputB64+          ]