purescript-iso 0.0.1.1 → 0.0.1.2

raw patch · 6 files changed

+53/−6 lines, 6 files

Files

purescript-iso.cabal +4/−2
src/Data/Aeson/JSONDateTime.hs +38/−0
src/Data/Aeson/JSONEither.hs +3/−1
src/Data/Aeson/JSONTuple.hs +3/−1
src/Data/Aeson/JSONUnit.hs +3/−1
test/Spec.hs +2/−1

purescript-iso.cabal view

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c6397c41d058e0b7c2155fd2e147eb98d3f4dd5c7b0782c38520d8c5f2ac8f78+-- hash: 3027dbec58707b55ea24b591ca5fb8d9bad467ac4211f9a7777444dbded91d3a  name:           purescript-iso-version:        0.0.1.1+version:        0.0.1.2 synopsis:       Isomorphic trivial data type definitions over JSON description:    Please see the README on GitHub at <https://github.com/githubuser/purescript-iso#readme> category:       Web@@ -27,6 +27,7 @@  library   exposed-modules:+      Data.Aeson.JSONDateTime       Data.Aeson.JSONEither       Data.Aeson.JSONTuple       Data.Aeson.JSONUnit@@ -50,6 +51,7 @@     , stm     , strict     , text+    , time     , utf8-string     , uuid     , zeromq4-haskell

+ src/Data/Aeson/JSONDateTime.hs view

@@ -0,0 +1,38 @@+{-# LANGUAGE+    GeneralizedNewtypeDeriving+  , DeriveGeneric+  #-}++module Data.Aeson.JSONDateTime where++import Data.Time+  ( UTCTime, formatTime, iso8601DateFormat, defaultTimeLocale+  , getCurrentTime, parseTimeOrError)+import Data.Aeson (ToJSON, FromJSON, decode)+import qualified Data.ByteString.Lazy.UTF8 as LBS8+import Test.QuickCheck (Arbitrary (..))+import GHC.Generics (Generic)+import System.IO.Unsafe (unsafePerformIO)+++newtype JSONDateTime = JSONDateTime+  { getJSONDateTime :: UTCTime+  } deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)+++jsonDateTime :: UTCTime -> JSONDateTime+jsonDateTime now =+  let p = take 3 (formatTime defaultTimeLocale "%q" now)+      s = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") now+      s' = s ++ "." ++ p ++ "Z"+  in  case decode $ LBS8.fromString $ show s' of+        Just x -> JSONDateTime x+        Nothing -> error s'+++instance Arbitrary JSONDateTime where+  arbitrary =+    let go = unsafePerformIO $ do+          now <- getCurrentTime+          pure (jsonDateTime now)+    in  go `seq` pure go

src/Data/Aeson/JSONEither.hs view

@@ -1,5 +1,6 @@ {-# LANGUAGE     OverloadedStrings+  , DeriveGeneric   #-}  module Data.Aeson.JSONEither where@@ -9,12 +10,13 @@ import Control.Applicative ((<|>)) import Test.QuickCheck (Arbitrary (..)) import Test.QuickCheck.Gen (oneof)+import GHC.Generics (Generic)   data JSONEither a b   = JSONLeft a   | JSONRight b-  deriving (Eq, Show)+  deriving (Eq, Ord, Show, Generic)  instance (ToJSON a, ToJSON b) => ToJSON (JSONEither a b) where   toJSON x = case x of

src/Data/Aeson/JSONTuple.hs view

@@ -1,5 +1,6 @@ {-# LANGUAGE     OverloadedStrings+  , DeriveGeneric   #-}  module Data.Aeson.JSONTuple where@@ -7,10 +8,11 @@ import Data.Aeson (ToJSON (..), FromJSON (..), Value (Object), object, (.=), (.:)) import Data.Aeson.Types (typeMismatch) import Test.QuickCheck (Arbitrary (..))+import GHC.Generics (Generic)   data JSONTuple a b = JSONTuple a b-  deriving (Eq, Show)+  deriving (Eq, Ord, Show, Generic)  instance (ToJSON a, ToJSON b) => ToJSON (JSONTuple a b) where   toJSON (JSONTuple a b) = object ["l" .= a, "r" .= b]

src/Data/Aeson/JSONUnit.hs view

@@ -1,5 +1,6 @@ {-# LANGUAGE     OverloadedStrings+  , DeriveGeneric   #-}  module Data.Aeson.JSONUnit where@@ -7,10 +8,11 @@ import Data.Aeson (ToJSON (..), FromJSON (..), Value (String)) import Data.Aeson.Types (typeMismatch) import Test.QuickCheck (Arbitrary (..))+import GHC.Generics (Generic)   data JSONUnit = JSONUnit-  deriving (Eq, Show)+  deriving (Eq, Ord, Show, Generic)  instance Arbitrary JSONUnit where   arbitrary = pure JSONUnit

test/Spec.hs view

@@ -5,6 +5,7 @@ import Data.Aeson.JSONUnit (JSONUnit) import Data.Aeson.JSONEither (JSONEither) import Data.Aeson.JSONTuple (JSONTuple)+import Data.Aeson.JSONDateTime (JSONDateTime) import Data.Time (UTCTime) import Data.Time.Calendar (Day) @@ -49,7 +50,7 @@   registerTopic "JSONEither" (Proxy :: Proxy (JSONEither JSONUnit JSONUnit))   registerTopic "JSONTuple" (Proxy :: Proxy (JSONTuple JSONUnit JSONUnit))   registerTopic "JSONDate" (Proxy :: Proxy Day)-  -- registerTopic "JSONDateTime" (Proxy :: Proxy UTCTime)+  registerTopic "JSONDateTime" (Proxy :: Proxy JSONDateTime)   jsonIso :: ToJSON a => FromJSON a => Eq a => a -> Result