aboutsummaryrefslogtreecommitdiff
path: root/common/src/Common/Util
diff options
context:
space:
mode:
Diffstat (limited to 'common/src/Common/Util')
-rw-r--r--common/src/Common/Util/Text.hs49
-rw-r--r--common/src/Common/Util/Time.hs26
-rw-r--r--common/src/Common/Util/Validation.hs13
3 files changed, 88 insertions, 0 deletions
diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs
new file mode 100644
index 0000000..0f9c187
--- /dev/null
+++ b/common/src/Common/Util/Text.hs
@@ -0,0 +1,49 @@
+module Common.Util.Text
+ ( search
+ , formatSearch
+ , unaccent
+ ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+search :: Text -> Text -> Bool
+search s t = (formatSearch s) `T.isInfixOf` (formatSearch t)
+
+formatSearch :: Text -> Text
+formatSearch = T.toLower . unaccent
+
+unaccent :: Text -> Text
+unaccent = T.map unaccentChar
+
+unaccentChar :: Char -> Char
+unaccentChar c = case c of
+ 'à' -> 'a'
+ 'á' -> 'a'
+ 'â' -> 'a'
+ 'ã' -> 'a'
+ 'ä' -> 'a'
+ 'ç' -> 'c'
+ 'è' -> 'e'
+ 'é' -> 'e'
+ 'ê' -> 'e'
+ 'ë' -> 'e'
+ 'ì' -> 'i'
+ 'í' -> 'i'
+ 'î' -> 'i'
+ 'ï' -> 'i'
+ 'ñ' -> 'n'
+ 'ò' -> 'o'
+ 'ó' -> 'o'
+ 'ô' -> 'o'
+ 'õ' -> 'o'
+ 'ö' -> 'o'
+ 'š' -> 's'
+ 'ù' -> 'u'
+ 'ú' -> 'u'
+ 'û' -> 'u'
+ 'ü' -> 'u'
+ 'ý' -> 'y'
+ 'ÿ' -> 'y'
+ 'ž' -> 'z'
+ _ -> c
diff --git a/common/src/Common/Util/Time.hs b/common/src/Common/Util/Time.hs
new file mode 100644
index 0000000..6240720
--- /dev/null
+++ b/common/src/Common/Util/Time.hs
@@ -0,0 +1,26 @@
+module Common.Util.Time
+ ( timeToDay
+ , parseDay
+ ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time (UTCTime)
+import qualified Data.Time as Time
+import Data.Time.Calendar (Day)
+import Data.Time.LocalTime
+import qualified Text.Read as T
+
+timeToDay :: UTCTime -> IO Day
+timeToDay time = localDay . (flip utcToLocalTime time) <$> getTimeZone time
+
+parseDay :: Text -> Maybe Day
+parseDay str = do
+ (y, m, d) <-
+ case T.splitOn "-" str of
+ [y, m, d] -> Just (y, m, d)
+ _ -> Nothing
+ d' <- T.readMaybe . T.unpack $ d
+ m' <- T.readMaybe . T.unpack $ m
+ y' <- T.readMaybe . T.unpack $ y
+ return $ Time.fromGregorian y' m' d'
diff --git a/common/src/Common/Util/Validation.hs b/common/src/Common/Util/Validation.hs
new file mode 100644
index 0000000..f195d95
--- /dev/null
+++ b/common/src/Common/Util/Validation.hs
@@ -0,0 +1,13 @@
+module Common.Util.Validation
+ ( isSuccess
+ , isFailure
+ ) where
+
+import Data.Validation (Validation (Failure, Success))
+
+isSuccess :: forall a b. Validation a b -> Bool
+isSuccess (Failure _) = False
+isSuccess (Success _) = True
+
+isFailure :: forall a b. Validation a b -> Bool
+isFailure = not . isSuccess