diff options
Diffstat (limited to 'common/src/Common/Util')
-rw-r--r-- | common/src/Common/Util/Text.hs | 49 | ||||
-rw-r--r-- | common/src/Common/Util/Time.hs | 26 | ||||
-rw-r--r-- | common/src/Common/Util/Validation.hs | 13 |
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 |