Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

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