packages feed

aws-sdk-text-converter (empty) → 0.1.0.0

raw patch · 6 files changed

+302/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, hspec, iproute, old-locale, safe, strptime, template-haskell, text, time

Files

+ Cloud/AWS/Lib/FromText.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}++module Cloud.AWS.Lib.FromText+    ( FromText+      ( fromText+      , fromNamedText+      )+    , deriveFromText+    , failText+    -- Re-exports+    , IPv4+    , AddrRange+    , Text+    , UTCTime+    ) where++import Control.Applicative ((<$>))+import Control.Monad+import Data.IP (IPv4, AddrRange)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import qualified Data.Time as Time+import qualified Data.Time.Parse as TP+import Language.Haskell.TH+import Safe++class FromText a where+    fromText :: Monad m => Text -> m a++    fromText' :: Monad m => Text -> m a+    fromText' name+        = maybe (failText name) return+        . fromText+        $ name++    fromNamedText :: Monad m => Text -> Maybe Text -> m a+    fromNamedText name+        = maybe+            (failText $ T.pack "no text name=" <> name)+            fromText'++failText :: Monad m => Text -> m a+failText msg = fail $ "FromText error: " <> T.unpack msg++instance FromText a => FromText (Maybe a) where+    fromText' = return . join . fromText+    fromNamedText _name Nothing  = return Nothing+    fromNamedText _name (Just t) = return $ fromText t+    fromText = return . fromText++instance FromText Int where+    fromText = fromTextToRead++instance FromText Integer where+    fromText = fromTextToRead++instance FromText Double where+    fromText = fromTextToRead++instance FromText IPv4 where+    fromText = fromTextToRead++instance FromText (AddrRange IPv4) where+    fromText = fromTextToRead++fromTextToRead :: (Monad m, Read a) => Text -> m a+fromTextToRead = readM . T.unpack++readM :: (Monad m, Read a) => String -> m a+readM a = maybe (fail $ "read failue: " <> a) return $ readMay a++instance FromText Text where+    fromText t+        | t == ""   = failText "Text"+        | otherwise = return t++instance FromText Bool where+    fromText "true"  = return True+    fromText "false" = return False+    fromText _       = failText "Bool"++instance FromText UTCTime where+    fromText t+        = maybe+            (fail "UTCTime")+            (return . Time.localTimeToUTC Time.utc)+        $ fst <$> (TP.strptime fmt $ T.unpack t)+      where+        fmt = "%FT%T"++deriveFromText :: String -> [String] -> DecsQ+deriveFromText dstr strs = do+    ctrs <- map (\(NormalC name _) -> name) <$> cons+    x <- newName "x"+    let cases = caseE (varE x) (map f (zip strs ctrs) ++ [wild])+    let fun = funD 'fromText [clause [varP x] (normalB cases) []]+    (:[]) <$> instanceD ctx typ [fun]+  where+    d = mkName dstr+    cons = do+        (TyConI (DataD _ _ _ cs _)) <- reify d+        return cs+    f (s, t) = match (litP $ stringL s) (normalB $ [|return $(conE t)|]) []+    wild = match wildP (normalB [|fail dstr|]) []+    typ = appT (conT ''FromText) (conT d)+    ctx = return []
+ Cloud/AWS/Lib/ToText.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances #-}++module Cloud.AWS.Lib.ToText+    ( ToText (toText)+    ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Data.IP (IPv4, AddrRange)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import qualified Data.Time as Time+import System.Locale (defaultTimeLocale)++class ToText a where+    toText :: a -> Text+    toMaybeText :: a -> Maybe Text+    toMaybeText = Just . toText++instance ToText Text where+    toText t = t++instance ToText ByteString where+    toText = T.pack . BC.unpack++instance ToText Bool where+    toText True  = "true"+    toText False = "false"++instance ToText UTCTime where+    toText+        = T.pack+        . Time.formatTime defaultTimeLocale "%FT%T"++instance ToText Int where+    toText = toTextFromShow++instance ToText Integer where+    toText = toTextFromShow++instance ToText Double where+    toText = toTextFromShow++instance ToText IPv4 where+    toText = toTextFromShow++instance ToText (AddrRange IPv4) where+    toText = toTextFromShow++toTextFromShow :: Show a => a -> Text+toTextFromShow = T.pack . show
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Yusuke Nomura++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 Yusuke Nomura 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
+ aws-sdk-text-converter.cabal view
@@ -0,0 +1,48 @@+name:                aws-sdk-text-converter+version:             0.1.0.0+synopsis:            The text converter for aws-sdk.+description:         The text converter for aws-sdk.+license:             BSD3+license-file:        LICENSE+homepage:            https://github.com/worksap-ate/aws-sdk-text-converter+author:              Yusuke Nomura <yunomu@gmail.com>+maintainer:          Yusuke Nomura <yunomu@gmail.com>+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Cloud.AWS.Lib.FromText+                     , Cloud.AWS.Lib.ToText+  ghc-options:         -Wall -fno-warn-unused-do-bind+  default-extensions:  OverloadedStrings+  build-depends:       base == 4.*+                     , template-haskell+                     , bytestring+                     , text+                     , time+                     , old-locale+                     , strptime+                     , safe+                     , iproute+  default-language:    Haskell2010++test-suite spec+  type:                exitcode-stdio-1.0+  hs-source-dirs:      ., test+  main-is:             Spec.hs+  ghc-options:         -Wall+  default-extensions:  OverloadedStrings+  default-language:    Haskell2010+  build-depends:       base == 4.*+                     , template-haskell+                     , bytestring+                     , text+                     , time+                     , old-locale+                     , strptime+                     , safe+                     , iproute+                     , hspec+                     , QuickCheck+                     , HUnit
+ test/Spec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++import Control.Applicative+import Data.IP+import Data.Time+import Test.Hspec+import Test.HUnit+import Test.Hspec.QuickCheck+import Test.QuickCheck++import Cloud.AWS.Lib.FromText+import Cloud.AWS.Lib.ToText++prop_class :: (Eq a, FromText a, ToText a) => a -> Bool+prop_class a = fromText (toText a) == Just a++instance Arbitrary Day where+    arbitrary = ModifiedJulianDay <$> arbitrary++instance Arbitrary DiffTime where+    arbitrary = secondsToDiffTime <$> choose (0, 60*60*24-1)++instance Arbitrary UTCTime where+    arbitrary = UTCTime <$> arbitrary <*> arbitrary++instance Arbitrary IPv4 where+    arbitrary = toIPv4 <$> vectorOf 4 (choose (0,255))++instance Arbitrary (AddrRange IPv4) where+    arbitrary = makeAddrRange <$> arbitrary <*> choose (0, 32)++prop_mclass :: (Eq a, FromText a, ToText a) => a -> Bool+prop_mclass a = fromText (toText a) == Just (Just a)++testNothing :: IO ()+testNothing = (fromText "" :: Maybe Int) @=? Nothing++data A = B | C deriving (Eq, Show)++instance ToText A where+    toText B = "ab"+    toText C = "ac"++deriveFromText "A" ["ab", "ac"]++instance Arbitrary A where+    arbitrary = elements [B, C]++main :: IO ()+main = hspec $ do+    describe "Cloud.AWS.Lib.{FromText,ToText}" $ do+        prop "Int" (prop_class :: Int -> Bool)+        prop "Integer" (prop_class :: Integer -> Bool)+        prop "Double" (prop_class :: Double -> Bool)+        prop "Bool" (prop_class :: Bool -> Bool)+        prop "UTCTime" (prop_class :: UTCTime -> Bool)+        prop "IPv4" (prop_class :: IPv4 -> Bool)+        prop "AddrRange IPv4" (prop_class :: AddrRange IPv4 -> Bool)+        prop "Maybe Int" (prop_mclass :: Int -> Bool)+        it "convert Nothing" testNothing+        prop "deriveFromText" (prop_class :: A -> Bool)