diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright © 2015 Anchor Systems, Pty Ltd +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + + 3. Neither the name of the project nor the names of its 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/lib/Data/Time/QQ.hs b/lib/Data/Time/QQ.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Time/QQ.hs @@ -0,0 +1,97 @@ +-- +-- Copyright © 2013-2015 Christian Marie +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | This module provides quasi quoters for writing time literals. +-- +-- First enable the 'QuasiQuotes' language extension, then you will be able to +-- write the the following: +-- +-- >>> [utcIso8601| 2048-12-01 |] :: UTCTime +-- 2048-12-01 00:00:00 UTC +-- +-- Unparseable dates will throw errors at compile time. +-- +-- Zoned time quoters are not provided as the time library doesn't seem to do +-- anything with \"%Z\". +module Data.Time.QQ +( + -- * ISO8601 UTC time QuasiQuoters + utcIso8601, + utcIso8601ms, + + -- * Re-exports + UTCTime(..), + + -- * Specify your own formats + utcFormat, +) where + +import Data.Time.Calendar +import Data.Time.Clock +import Data.Time.Format +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax +import System.Locale + +-- | ISO8601 date with seconds and optional "." with more precision +-- following to a 'UTCTime'. +-- +-- Do not specify a timezone, the time should be UTC. +-- +-- >>> [utcIso8601ms| 2099-01-01T00:00:00.42324 |] +-- 2099-01-01 00:00:00.42324 UTC +utcIso8601ms :: QuasiQuoter +utcIso8601ms = utcFormat . iso8601DateFormat $ Just "%H:%M:%S%Q" + +-- | ISO8601 date with seconds and optional "." with more precision +-- following to a 'UTCTime'. +-- +-- Do not specify a timezone, the time should be UTC. +-- +-- >>> [utcIso8601| 2048-12-01 |] :: UTCTime +-- 2048-12-01 00:00:00 UTC +utcIso8601 :: QuasiQuoter +utcIso8601 = utcFormat $ iso8601DateFormat Nothing + +-- | Build a 'UTCTime' QuasiQuoter for a given format string, as per +-- 'readTime'. +utcFormat :: String -> QuasiQuoter +utcFormat format = QuasiQuoter + { quoteExp = utcExp format + , quotePat = const $ error "No quotePat defined for any Data.Time.QQ QQ" + , quoteType = const $ error "No quoteType defined for any Data.Time.QQ QQ" + , quoteDec = const $ error "No quoteDec defined for any Data.Time.QQ QQ" + } + +-- | Parse a time as per the format and produce a 'UTCTime' 'ExpQ'. +utcExp :: String -> String -> ExpQ +utcExp format input = + let x = readTime defaultTimeLocale format input :: UTCTime + in x `seq` [| x |] + + +-- * Instances for lifting times + +instance Lift UTCTime where + lift (UTCTime day diff) = do + day' <- lift day + diff' <- lift diff + return $ ConE (mkName "UTCTime") `AppE` day' `AppE` diff' + +instance Lift DiffTime where + lift x = [| toEnum $(lift $ fromEnum x) |] + +instance Lift Day where + lift x = [| toEnum $(lift $ fromEnum x) |] + + diff --git a/tests/unit.hs b/tests/unit.hs new file mode 100644 --- /dev/null +++ b/tests/unit.hs @@ -0,0 +1,31 @@ +-- +-- Copyright © 2013-2015 Christian Marie +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +{-# LANGUAGE QuasiQuotes #-} + +module Main where + +import Data.Time.QQ +import Test.Hspec + +main :: IO () +main = hspec suite + +suite :: Spec +suite = + describe "UTC QQs" $ do + it "has correct output #1" $ + show [utcIso8601| 2048-12-01 |] + `shouldBe` "2048-12-01 00:00:00 UTC" + it "has correct output #2" $ + show [utcIso8601ms| 2099-01-01T00:00:00.42324 |] + `shouldBe` "2099-01-01 00:00:00.42324 UTC" + it "has correct output #3" $ + show [utcIso8601ms| 2099-01-01T00:00:00 |] + `shouldBe` "2099-01-01 00:00:00 UTC" diff --git a/time-qq.cabal b/time-qq.cabal new file mode 100644 --- /dev/null +++ b/time-qq.cabal @@ -0,0 +1,35 @@ +name: time-qq +version: 0.0.0.1 +synopsis: Quasi-quoter for UTCTime times +description: Quasi-quoter for UTCTime times +homepage: https://github.com/christian-marie/time-qq +license: BSD3 +license-file: LICENSE +author: Christian Marie +maintainer: Christian Marie +copyright: Christian Marie +category: Time, QuasiQuotes +build-type: Simple +cabal-version: >= 1.18 + +source-repository HEAD + type: git + location: https://github.com/christian-marie/time-qq + +library + default-language: Haskell2010 + hs-source-dirs: lib + exposed-modules: Data.Time.QQ + build-depends: base >=4.7 && <5 + , template-haskell + , time >= 1.4 + , old-locale + +test-suite unit + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: tests + main-is: unit.hs + build-depends: base >=4.7 && <5 + , hspec + , time-qq