digestive-functors 0.6.1.1 → 0.6.2.0

raw patch · 2 files changed

+119/−6 lines, 2 filesdep +old-localedep +time

Dependencies added: old-locale, time

Files

• digestive-functors.cabal +7/−3
• src/Text/Digestive/Form.hs +112/−3

@@ -1,5 +1,5 @@ Name:     digestive-functors-Version:  0.6.1.1+Version:  0.6.2.0 Synopsis: A practical formlet library  Description:@@ -62,7 +62,9 @@     bytestring >= 0.9     && < 0.11,     containers >= 0.3     && < 0.6,     mtl        >= 1.1.0.0 && < 3,-    text       >= 0.10    && < 1.1+    old-locale >= 1.0     && < 1.1,+    text       >= 0.10    && < 1.1,+    time       >= 1.4     && < 1.5  Test-suite digestive-functors-tests   Type:           exitcode-stdio-1.0@@ -92,7 +94,9 @@     bytestring >= 0.9     && < 0.11,     containers >= 0.3     && < 0.6,     mtl        >= 1.1.0.0 && < 3,-    text       >= 0.10    && < 1.1+    old-locale >= 1.0     && < 1.1,+    text       >= 0.10    && < 1.1,+    time       >= 1.4     && < 1.5  Source-repository head   Type:     git

@@ -32,6 +32,16 @@     , optionalString     , optionalStringRead +      -- * Date/time forms+    , utcTimeFormlet+    , localTimeFormlet+    , dateFormlet+    , timeFormlet+    , optionalUtcTimeFormlet+    , optionalLocalTimeFormlet+    , optionalDateFormlet+    , optionalTimeFormlet+       -- * Validation and transformation     , check     , checkM@@ -48,11 +58,14 @@   ---------------------------------------------------------------------------------import           Control.Monad                      (liftM)+import           Control.Applicative+import           Control.Monad                      (liftM, liftM2) import           Data.List                          (findIndex) import           Data.Maybe                         (fromMaybe) import           Data.Text                          (Text) import qualified Data.Text                          as T+import           Data.Time+import           System.Locale   --------------------------------------------------------------------------------@@ -239,9 +252,9 @@ -- returns nothing if no optional text was set, and no input -- was retrieved. optionalText :: Monad m => Maybe Text -> Form v m (Maybe Text)-optionalText def = validate optional (text def)+optionalText def = validate opt (text def)   where-    optional t+    opt t         | T.null t  = return Nothing         | otherwise = return $ Just t @@ -287,5 +300,101 @@ -- Manipulatable indices listIndices :: Monad m => [Int] -> Form v m [Int] listIndices = fmap parseIndices . text . Just . unparseIndices+++------------------------------------------------------------------------------+--                            Date/time formlets+------------------------------------------------------------------------------+++utcTimeFormlet :: Monad m+               => String+                 -- ^ Date format string+               -> String+                 -- ^ Time format string+               -> TimeZone+               -> Formlet Text m UTCTime+utcTimeFormlet dFmt tFmt tz d =+    localTimeToUTC tz <$> localTimeFormlet dFmt tFmt (utcToLocalTime tz <$> d)+++localTimeFormlet :: Monad m+                 => String+                   -- ^ Date format string+                 -> String+                   -- ^ Time format string+                 -> Formlet Text m LocalTime+localTimeFormlet dFmt tFmt d = LocalTime+      <$> "date" .: dateFormlet dFmt (localDay <$> d)+      <*> "time" .: timeFormlet tFmt (localTimeOfDay <$> d)+++dateFormlet :: Monad m+            => String+              -- ^ Format string+            -> Formlet Text m Day+dateFormlet fmt d =+    validate (vFunc fmt "invalid date") (string $ formatTime defaultTimeLocale fmt <$> d)+++timeFormlet :: Monad m+            => String+              -- ^ Format string+            -> Formlet Text m TimeOfDay+timeFormlet fmt d =+    validate (vFunc fmt "invalid time") (string $ formatTime defaultTimeLocale fmt <$> d)+++optionalUtcTimeFormlet :: Monad m+                       => String+                         -- ^ Date format string+                       -> String+                         -- ^ Time format string+                       -> TimeZone+                       -> Maybe UTCTime+                       -> Form Text m (Maybe UTCTime)+optionalUtcTimeFormlet dFmt tFmt tz d =+    liftM (localTimeToUTC tz) <$> optionalLocalTimeFormlet dFmt tFmt (utcToLocalTime tz <$> d)+++optionalLocalTimeFormlet :: Monad m+                         => String+                           -- ^ Date format string+                         -> String+                           -- ^ Time format string+                         -> Maybe LocalTime+                         -> Form Text m (Maybe LocalTime)+optionalLocalTimeFormlet dFmt tFmt d = liftM2 LocalTime+      <$> "date" .: optionalDateFormlet dFmt (localDay <$> d)+      <*> "time" .: optionalTimeFormlet tFmt (localTimeOfDay <$> d)+++optionalDateFormlet :: Monad m+                    => String+                      -- ^ Format string+                    -> Maybe Day+                    -> Form Text m (Maybe Day)+optionalDateFormlet fmt d =+    validate (vOpt $ vFunc fmt "invalid date") (string $ formatTime defaultTimeLocale fmt <$> d)+++optionalTimeFormlet :: Monad m+                    => String+                      -- ^ Format string+                    -> Maybe TimeOfDay+                    -> Form Text m (Maybe TimeOfDay)+optionalTimeFormlet fmt d =+    validate (vOpt $ vFunc fmt "invalid time") (string $ formatTime defaultTimeLocale fmt <$> d)+++vFunc :: ParseTime a => String -> Text -> String -> Result Text a+vFunc fmt err x+  | length x < 40 = maybe (Error err) Success $ parseTime defaultTimeLocale fmt x+  | otherwise = Error "Not a valid date/time string"+++vOpt :: (String -> Result v a) -> String -> Result v (Maybe a)+vOpt _ "" = Success Nothing+vOpt f x  = Just <$> f x