diff options
| author | Joris | 2018-11-01 13:14:25 +0100 |
|---|---|---|
| committer | Joris | 2019-08-04 21:14:32 +0200 |
| commit | 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 (patch) | |
| tree | ea5f685cdf8f3de2efa1113325d45faaa90c977e | |
| parent | 86957359ecf54c205aee1c09e151172c327e987a (diff) | |
| download | budget-2741f47ef7b87255203bc2f7f7b2b9140c70b8f0.tar.gz budget-2741f47ef7b87255203bc2f7f7b2b9140c70b8f0.tar.bz2 budget-2741f47ef7b87255203bc2f7f7b2b9140c70b8f0.zip | |
Implementing client side validation
39 files changed, 1234 insertions, 341 deletions
diff --git a/.ghc.environment.x86_64-linux-8.4.3 b/.ghc.environment.x86_64-linux-8.4.3 deleted file mode 100644 index 7d3e48e..0000000 --- a/.ghc.environment.x86_64-linux-8.4.3 +++ /dev/null @@ -1,157 +0,0 @@ --- This is a GHC environment file written by cabal. This means you can --- run ghc or ghci and get the environment of the project as a whole. --- But you still need to use cabal repl $target to get the environment --- of specific components (libs, exes, tests etc) because each one can --- have its own source dirs, cpp flags etc. --- -clear-package-db -global-package-db -package-db /home/joris/.cabal/store/ghc-8.4.3/package.db -package-db dist-server/packagedb/ghc-8.4.3 -package-id common-0.0.1-inplace -package-id aeson-1.3.1.1-Lq3qt0bucT8Ce9ru8xJuCI -package-id attoparsec-0.13.2.2-ATx7nMcxk3nBRIyNYmGqiS -package-id array-0.5.2.0 -package-id base-4.11.1.0 -package-id rts -package-id ghc-prim-0.5.2.0 -package-id integer-gmp-1.0.2.0 -package-id bytestring-0.10.8.2 -package-id deepseq-1.4.3.0 -package-id containers-0.5.11.0 -package-id scientific-0.3.6.2-CQmXpomPvoD3ixE02xGLRK -package-id integer-logarithms-1.0.2.1-KTtq4CBpjpvEUZ9qRz5Dnw -package-id text-1.2.3.0 -package-id binary-0.8.5.1 -package-id hashable-1.2.7.0-3tjvi3NV6rN9wchx0YHnZD -package-id primitive-0.6.3.0-DaZpcxwJp2TGn8ITSgfI4C -package-id transformers-0.5.5.0 -package-id base-compat-0.10.4-9FtFg9E90S5CFRyvxjUaaZ -package-id unix-2.7.2.2 -package-id time-1.8.0.2 -package-id dlist-0.8.0.4-EWVGGTJvTTW8quLYK9yz9r -package-id tagged-0.8.5-4YetGW889ApC8am7APN51M -package-id template-haskell-2.13.0.0 -package-id ghc-boot-th-8.4.3 -package-id pretty-1.1.3.6 -package-id transformers-compat-0.6.2-EZ0ZvADLUlc4V8RuKaJX5W -package-id th-abstraction-0.2.8.0-Ct896m4STpK8GA15Cl5y88 -package-id time-locale-compat-0.1.1.5-KqeVbnHNo2M7DUvscbLCec -package-id unordered-containers-0.2.9.0-5IJJnkQI2ZvDdhI29XIpGM -package-id uuid-types-1.0.3-8w4UPTs1JS8B9G14pA0XAT -package-id random-1.1-9LLJAJa4iQFLJiLXBOBXBV -package-id vector-0.12.0.1-4awQG9XUvVEBfJgKGHBhOb -package-id base64-bytestring-1.0.0.1-5trcv0VH0VU6H0uIZkhZ3k -package-id blaze-builder-0.4.1.0-5wTyfrZhdBm5HR5E6AoC8q -package-id blaze-html-0.9.1.1-2WuVUrAVuLu82r7EJau7GP -package-id blaze-markup-0.8.2.1-5q61W3qlhuHHgHlyBxVWdI -package-id clay-0.13.1-8XtTo244BlHJ5E7LTRpxDO -package-id mtl-2.2.2 -package-id clientsession-0.9.1.2-Kp1X4vuJeaaJGosy9Go9AT -package-id cereal-0.5.7.0-1u6PhbqJMrKHERqJJagiCb -package-id directory-1.3.1.5 -package-id filepath-1.4.2 -package-id crypto-api-0.13.3-9IodYT3eNDPBQONIDwB97L -package-id entropy-0.4.1.1-FmBdJKRG6hQDsYzBhT7c6v -package-id skein-1.0.9.4-KqWA7IwIzMC5B1u6Q3OfIC -package-id cprng-aes-0.6.1-63etvHRpER8EeGrwwFmDBf -package-id byteable-0.1.1-APABKKN6nDlC3QxQBw4YlY -package-id crypto-random-0.0.9-8Tu8ZbKJeNNKNdtsawKUJP -package-id securemem-0.1.10-47zZUPlFQPlLT2d3byocKS -package-id memory-0.14.16-GTCi0eCrvrnI3inLDBWVMK -package-id basement-0.0.8-8QjArDsw3GWCcbHE5iqtz3 -package-id foundation-0.0.21-2XnEGrFO7ZkKqT4yFq3WNW -package-id cipher-aes-0.2.11-JuxqKjUdElsKUllS45vrnr -package-id crypto-cipher-types-0.0.9-Iu6qf1HOoNxJnMNZvefoYo -package-id setenv-0.1.1.3-H1xmIqlPy4yIDquO6eJhBl -package-id config-manager-0.3.0.1-ErZESEYU0J61ILS0rVvaqp -package-id parsec-3.1.13.0 -package-id cookie-0.4.4-CbgKffgfVXL7ehGVl03UQt -package-id data-default-class-0.1.2.0-2kYzERBLX3wJoPfj7mwVvW -package-id email-validate-2.3.2.6-5cF9aOuvvJ3B7vRZe3M5wS -package-id http-conduit-2.3.2-9qWpTkSiT7OIggksuiU0NL -package-id resourcet-1.2.1-VQ4XM4cYxr16gqpSEgCOy -package-id exceptions-0.10.0-D5kcCq3onNJ8Xd3zaVEIaB -package-id stm-2.4.5.0 -package-id unliftio-core-0.1.2.0-900TPot3SR34dceIcVaslS -package-id conduit-1.3.0.3-Ag2soCkulYh4LXK7KSKXoI -package-id mono-traversable-1.0.9.0-ClemTK6PNuCEdKAFXMoJbR -package-id split-0.2.3.3-EmQETEsKhhCBcRcdyKMbme -package-id vector-algorithms-0.7.0.4-LTeQMW2mffA77UAhZhdPqK -package-id conduit-extra-1.3.0-IvU7g6gaQD229U2EMYtyRt -package-id async-2.2.1-9Pc6MzjEaIMLKHdFpoYFYT -package-id network-2.6.3.6-2g6VId0Xlc85XRtUcfQj0T -package-id process-1.6.3.0 -package-id streaming-commons-0.2.1.0-EohdSCkYJCzJ8j6F5uKOLe -package-id zlib-0.6.2-FP80mWgJNoyCiVcPtw6kKj -package-id typed-process-0.2.3.0-3tpgRagpzJP7pjiSyDz0nm -package-id http-types-0.12.1-GrpELT1BwSZHH8qr3E2SOs -package-id case-insensitive-1.2.0.11-JyXkkg6pL0XjfMAnCwmax -package-id http-client-0.5.13.1-9cMLZOykl2HLT4rQDGR74b -package-id mime-types-0.1.0.8-LKKvOy4Qa71IxJa0ssc0G3 -package-id network-uri-2.6.1.0-58iE8XZUuHG29WOa1Wcd6B -package-id http-client-tls-0.3.5.3-Ijx3BXTqwcWHk6zAxUfVZC -package-id connection-0.2.8-KsXaNBvRY6SEBsRXaIsNph -package-id socks-0.5.6-E2UdBGsYbPg15P7ufoQudW -package-id tls-1.4.1-86xaCnbqM9j4gcJwKoy8kL -package-id cryptonite-0.25-GgyZs9E1viv2owjaLxA3vq -package-id asn1-types-0.3.2-D5pV0M5JoITIzfbcuQzEgZ -package-id hourglass-0.2.12-3UpIPqczZGGFB8xo4AtO7k -package-id asn1-encoding-0.9.5-GlFjXiAJ16sE0dEqFJUiZm -package-id x509-1.7.3-6xPfCnkvwZA7yWmuNY705r -package-id pem-0.2.4-KNeFq9SFLwqKj6C5ugBM0P -package-id asn1-parse-0.9.4-GPR0gL1pKKm7p8d8kand6q -package-id x509-store-1.6.6-IqoEuOPiJVoFoe5dvQdGI -package-id x509-validation-1.6.10-BPP7TLcoO4h8axlCTrfvOz -package-id x509-system-1.6.6-GHbFvQ8bgRK7oqdcOEJZc9 -package-id mime-mail-0.4.14-F6ySGbdVER65wtqCqWqOl3 -package-id monad-logger-0.3.29-6bZsQD4SE1xLoctmBqiUHU -package-id fast-logger-2.4.11-GgPMTheucOf1lpGoClAZZ9 -package-id auto-update-0.1.4-7k5Okr80TfS9UGlvnbDZr0 -package-id easy-file-0.2.2-4l2xgq1xN4PHgDPMu188oI -package-id unix-time-0.3.8-5bbDZ3NgOpv6wzZECQszPQ -package-id old-time-1.1.0.3-2H7uVRdRD4GDRLoYt56mwc -package-id old-locale-1.0.0.7-26K7wLFR2jK44UeOklvTCh -package-id lifted-base-0.2.3.12-8egLh9Bh3xRGu9ioodnJbr -package-id transformers-base-0.4.5.2-15Q5KM4EiRA3cyTs4bqRMY -package-id base-orphans-0.7-53B8vWYZ549FoHd6pWzX45 -package-id monad-control-1.0.2.3-YxLr8wGYVF1whrb88JCVF -package-id monad-loops-0.4.3-4dVf0xJrZft7wNMs79AFwP -package-id stm-chans-3.0.0.4-1zxsnYr1r3u2n2uZuqSuqq -package-id scotty-0.11.2-Aakq2WpJ8g59uR4UgaFkV2 -package-id fail-4.9.0.0-BAHmj60kS5K7NVhhKpm9J5 -package-id nats-1.1.2-1IJUekZt6ps5IWVCKMBPeK -package-id regex-compat-0.95.1-GpayP5pCY7oFkOLgNVrkag -package-id regex-base-0.93.2-98bD2PeVUkV8MO804tnXmq -package-id regex-posix-0.95.2-FLMmMz75XIwP5t3X8eXe -package-id wai-3.2.1.2-tyzSRIN6w83qZ0VQLCWbw -package-id vault-0.3.1.2-1TB2YirTMicAuuTDRwE6kX -package-id semigroups-0.18.5-E4FVMc5VZAG98u64romz5 -package-id wai-extra-3.0.24.2-AvTLVrqVXmKA5VMHa9boEF -package-id wai-logger-2.3.2-FDfZC2RZ3dFAtwJUbKFuvA -package-id byteorder-1.0.4-JGHrMy8StI888DOmmSVbRy -package-id ansi-terminal-0.8.0.4-JygoK7BZB5m4K6OxT2muhl -package-id colour-2.3.4-C3PVIHDZkyCIpOJGl3M0hE -package-id void-0.7.2-AeUlTizrscF7IT5YtjodSF -package-id stringsearch-0.3.6.6-6DZU68MAKlcJFBtzhQCsgS -package-id word8-0.1.3-K7c7pnNichCC0T510LrMTC -package-id unix-compat-0.5.1-IZ2l0C7CE13FdrCF8rJfBj -package-id iproute-1.7.5-sGroOlpubcDgMr0Wr8rcw -package-id appar-0.1.4-J5mdtVuytVIKFPXD2MXW4E -package-id warp-3.2.23-2pmcK8CzflY6enLxynQiQ -package-id bsb-http-chunked-0.0.0.3-E7NwspJN6SxIKqIRCJ80gO -package-id bytestring-builder-0.10.8.1.0-79xKWk2yKAy2kdzRqfwsUV -package-id http2-1.6.3-17wK0i2oRMq6bDCOjAuG6e -package-id psqueues-0.2.7.0-61W4WPtGYUOI5ei0j8xe3i -package-id simple-sendfile-0.2.27-2TzFC62eMnEJApcSMGU0P6 -package-id http-date-0.0.8-H1gAnhnvIOqv1hADs2y4c -package-id sqlite-simple-0.4.16.0-1X7hKRWKO0T3XyEgQEMkzU -package-id blaze-textual-0.2.1.0-DyWVSpyf0gV3fMlgELHYIq -package-id direct-sqlite-2.3.24-IIklpzBOtgwBoWbRSy0dek -package-id Only-0.1-ESoRmRbP5ByJm8IsgOJKc0 -package-id uuid-1.3.13-F6NIzx4IcRFHIkFHCKpKxt -package-id cryptohash-sha1-0.11.100.1-8iUWTKIak4F2397EhPbMrb -package-id cryptohash-md5-0.11.100.1-GxTbFNHFy9d4RJgBkoQPg7 -package-id network-info-0.2.0.10-Jad1urRPRS69Kkzc04cakY -package-id wai-middleware-static-0.8.2-FLTnHo5pQAg9J9aQ1NGcN0 -package-id expiring-cache-map-0.0.6.1-7nOabKJZiSQ8IBqNWYOW5A @@ -8,3 +8,4 @@ public/javascript/main.js result-client result-server sessionKey +.ghc.environment.* diff --git a/.tmuxinator.yml b/.tmuxinator.yml index 2d52bb4..2a765c0 100644 --- a/.tmuxinator.yml +++ b/.tmuxinator.yml @@ -1,13 +1,14 @@ name: sharedCost +startup_window: app windows: - console: - clear - app: panes: - - client: - - make watch-client - server: - make watch-server + - client: + - make watch-client - db: - sqlite3 database @@ -60,6 +60,7 @@ TODO ### Interface +- Add loader in the initial html page, that is showed before the JS code is running - Add payment error handling. - Delete payment waitFor. - Edit a payment. diff --git a/client/client.cabal b/client/client.cabal index 26ad2ec..af71f2d 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -21,8 +21,8 @@ Executable client RecursiveDo Build-depends: - aeson - , base >=4.9 && <5 + aeson + , base >= 4.11 && < 5 , bytestring , common , containers @@ -32,8 +32,10 @@ Executable client , reflex-dom , text , time + , validation other-modules: + Component Component.Button Component.Form Component.Input @@ -42,7 +44,9 @@ Executable client Icon Util.Ajax Util.Dom + Util.Either Util.List + Util.Validation Util.WaitFor View.App View.Header diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs index 57018a6..67f97c0 100644 --- a/client/src/Component/Input.hs +++ b/client/src/Component/Input.hs @@ -5,59 +5,91 @@ module Component.Input , defaultInputIn ) where -import qualified Data.Map as M -import Data.Text (Text) -import qualified Data.Text as T -import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex, (&), - (.~)) -import qualified Reflex.Dom as R - -import Component.Button (ButtonIn (..), ButtonOut (..)) -import qualified Component.Button as Button +import qualified Data.Map as M +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (NominalDiffTime) +import Data.Validation (Validation (Failure, Success)) +import qualified Data.Validation as V +import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex, + (&), (.~)) +import qualified Reflex.Dom as R + +import qualified Common.Util.Validation as ValidationUtil +import Component.Button (ButtonIn (..), ButtonOut (..)) +import qualified Component.Button as Button import qualified Icon -data InputIn = InputIn +data InputIn a = InputIn { _inputIn_hasResetButton :: Bool , _inputIn_label :: Text , _inputIn_initialValue :: Text , _inputIn_inputType :: Text + , _inputIn_validation :: Text -> Validation Text a } -defaultInputIn :: InputIn +defaultInputIn :: InputIn Text defaultInputIn = InputIn { _inputIn_hasResetButton = True , _inputIn_label = "" , _inputIn_initialValue = "" , _inputIn_inputType = "text" + , _inputIn_validation = V.Success } -data InputOut t = InputOut - { _inputOut_value :: Dynamic t Text +data InputOut t a = InputOut + { _inputOut_raw :: Dynamic t Text + , _inputOut_value :: Dynamic t (Maybe (Validation Text a)) , _inputOut_enter :: Event t () } input :: forall t m a b. MonadWidget t m - => InputIn - -> Event t a -- reset - -> m (InputOut t) -input inputIn reset = - R.divClass "textInput" $ do - rec - let resetValue = R.leftmost - [ fmap (const "") reset - , fmap (const "") resetClic - ] - - attributes = R.ffor value (\v -> - if T.null v && _inputIn_inputType inputIn /= "date" - then M.empty - else M.singleton "class" "filled") - - value = R._textInput_value textInput + => InputIn a + -> Event t Text -- reset + -> Event t b -- validate + -> m (InputOut t a) +input inputIn reset validate = do + rec + let resetValue = R.leftmost + [ R.traceEvent "reset" reset + , fmap (const "") resetClic + ] + + inputAttr = R.ffor value (\v -> + if T.null v && _inputIn_inputType inputIn /= "date" + then M.empty + else M.singleton "class" "filled") + + value = R._textInput_value textInput + + containerAttr = R.ffor validatedValue (\v -> + M.singleton "class" $ T.intercalate " " + [ "textInput" + , if Maybe.fromMaybe False (ValidationUtil.isFailure <$> v) then "error" else "" + ]) + + -- Clear validation errors after reset + delayedReset <- R.delay (0.1 :: NominalDiffTime) reset + + validatedValue <- R.holdDyn Nothing $ R.attachWith + (\v (clearValidation, validateEmpty) -> + if clearValidation + then Nothing + else Just (_inputIn_validation inputIn $ (if validateEmpty then "" else v))) + (R.current value) + (R.leftmost + [ const (False, True) <$> resetClic + , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput) + , const (False, False) <$> validate + , const (True, False) <$> R.traceEvent "delayedReset" delayedReset + ]) + + (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do textInput <- R.textInput $ R.def - & R.attributes .~ attributes + & R.attributes .~ inputAttr & R.setValue .~ resetValue & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn) & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn) @@ -75,9 +107,19 @@ input inputIn reset = else return R.never - let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput + R.divClass "errorMessage" $ + R.dynText . fmap validationError $ validatedValue + + return (textInput, resetClic) + + let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput + + return $ InputOut + { _inputOut_raw = value + , _inputOut_value = validatedValue + , _inputOut_enter = enter + } - return $ InputOut - { _inputOut_value = value - , _inputOut_enter = enter - } +validationError :: Maybe (Validation Text a) -> Text +validationError (Just (Failure e)) = e +validationError _ = "" diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs index b86fee0..d7943a9 100644 --- a/client/src/Component/Modal.hs +++ b/client/src/Component/Modal.hs @@ -23,11 +23,12 @@ data ModalIn t m a = ModalIn , _modalIn_content :: m a } -data ModalOut a = ModalOut +data ModalOut t a = ModalOut { _modalOut_content :: a + , _modalOut_hide :: Event t () } -modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut a) +modal :: forall t m a. MonadWidget t m => ModalIn t m a -> m (ModalOut t a) modal modalIn = do rec let showEvent = R.leftmost @@ -48,6 +49,7 @@ modal modalIn = do return $ ModalOut { _modalOut_content = content + , _modalOut_hide = curtainClick } getAttributes :: Bool -> LM.Map Text Text @@ -67,12 +69,13 @@ performShowEffects showEvent elem = do let showEffects = flip fmap showEvent (\show -> do - if show - then - do - Node.appendChild body elem - Element.setClassName body ("modal" :: JSString) - else + if show then + do + Node.appendChild body elem + Element.setClassName body ("modal" :: JSString) + else + do + Node.removeChild body elem Element.setClassName body ("" :: JSString) ) diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs index 7cb6726..9f671d3 100644 --- a/client/src/Component/Select.hs +++ b/client/src/Component/Select.hs @@ -5,34 +5,65 @@ module Component.Select ) where import Data.Map (Map) +import qualified Data.Map as M import Data.Text (Text) +import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex) import qualified Reflex.Dom as R -data (Reflex t) => SelectIn t a = SelectIn +import qualified Common.Msg as Msg + +data (Reflex t) => SelectIn t a b c = SelectIn { _selectIn_label :: Text , _selectIn_initialValue :: a , _selectIn_values :: Dynamic t (Map a Text) - , _selectIn_reset :: Event t () + , _selectIn_reset :: Event t b + , _selectIn_isValid :: a -> Bool + , _selectIn_validate :: Event t c } data SelectOut t a = SelectOut { _selectOut_value :: Dynamic t a } -select :: forall t m a. (Ord a, MonadWidget t m) => SelectIn t a -> m (SelectOut t a) -select selectIn = - R.divClass "selectInput" $ do - R.el "label" $ R.text (_selectIn_label selectIn) +select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a) +select selectIn = do + rec + let containerAttr = R.ffor hasError (\e -> + M.singleton "class" $ T.intercalate " " + [ "selectInput" + , if e then "error" else "" + ]) + + hasError <- R.holdDyn False $ R.attachWith + (\v clearError -> not clearError && not (_selectIn_isValid selectIn v)) + (R.current value) + (R.leftmost + [ const False <$> _selectIn_validate selectIn + , const True <$> _selectIn_reset selectIn + ]) + + value <- R.elDynAttr "div" containerAttr $ do + R.el "label" $ R.text (_selectIn_label selectIn) + + let initialValue = _selectIn_initialValue selectIn + + value <- R._dropdown_value <$> + R.dropdown + initialValue + (_selectIn_values selectIn) + (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) + + errorMessage <- R.holdDyn "" $ R.attachWith + (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!") + (R.current value) + (_selectIn_validate selectIn) - let initialValue = _selectIn_initialValue selectIn + R.divClass "errorMessage" . R.dynText $ + R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "") - value <- R._dropdown_value <$> - R.dropdown - initialValue - (_selectIn_values selectIn) - (R.def { R._dropdownConfig_setValue = fmap (const initialValue) (_selectIn_reset selectIn) }) + return value - return SelectOut - { _selectOut_value = value - } + return SelectOut + { _selectOut_value = value + } diff --git a/client/src/Util/Validation.hs b/client/src/Util/Validation.hs new file mode 100644 index 0000000..e2a3dcb --- /dev/null +++ b/client/src/Util/Validation.hs @@ -0,0 +1,37 @@ +module Util.Validation + ( fireValidation + , fireMaybe + , nelError + ) where + +import Control.Monad (join) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NEL +import Data.Text (Text) +import Data.Validation (Validation (Failure, Success)) +import qualified Data.Validation as Validation +import Reflex.Dom (Dynamic, Event, Reflex) +import qualified Reflex.Dom as R + +nelError :: Validation a b -> Validation (NonEmpty a) b +nelError = Validation.validation (Failure . NEL.fromList . (:[])) Success + +fireValidation + :: forall t a b c. Reflex t + => Dynamic t (Maybe (Validation a b)) + -> Event t c + -> Event t b +fireValidation value validate = + R.fmapMaybe + (join . fmap (Validation.validation (const Nothing) Just)) + (R.tag (R.current value) validate) + +fireMaybe + :: forall t a b. Reflex t + => Dynamic t (Maybe a) + -> Event t b + -> Event t a +fireMaybe value validate = + R.fmapMaybe + id + (R.tag (R.current value) validate) diff --git a/client/src/View/App.hs b/client/src/View/App.hs index 9aa6c57..6435297 100644 --- a/client/src/View/App.hs +++ b/client/src/View/App.hs @@ -16,7 +16,8 @@ import qualified View.SignIn as SignIn widget :: InitResult -> IO () widget initResult = - R.mainWidget $ do + R.mainWidget $ R.divClass "app" $ do + headerOut <- Header.view $ HeaderIn { _headerIn_initResult = initResult } diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs index 5245e72..007471d 100644 --- a/client/src/View/Payment.hs +++ b/client/src/View/Payment.hs @@ -30,7 +30,7 @@ data PaymentOut = PaymentOut widget :: forall t m. MonadWidget t m => PaymentIn -> m PaymentOut widget paymentIn = do - R.divClass "payment" $ do + R.elClass "main" "payment" $ do rec let init = _paymentIn_init paymentIn paymentsPerPage = 7 diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs index 061eeeb..62b26a3 100644 --- a/client/src/View/Payment/Add.hs +++ b/client/src/View/Payment/Add.hs @@ -4,31 +4,34 @@ module View.Payment.Add , AddOut(..) ) where -import Control.Monad.IO.Class (liftIO) -import qualified Data.Map as M -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Time.Calendar as Calendar -import qualified Data.Time.Clock as Time -import Reflex.Dom (Event, MonadWidget, Reflex) -import qualified Reflex.Dom as R -import qualified Text.Read as T - -import Common.Model (Category (..), CreatePayment (..), - Frequency (..), Payment (..)) -import qualified Common.Msg as Msg -import qualified Common.Util.Time as Time -import Component (ButtonIn (..), InputIn (..), - InputOut (..), SelectIn (..), - SelectOut (..)) -import qualified Component as Component -import qualified Util.Ajax as Ajax -import qualified Util.Either as EitherUtil -import qualified Util.WaitFor as WaitFor +import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M +import qualified Data.Maybe as Maybe +import qualified Data.Text as T +import qualified Data.Time.Calendar as Calendar +import qualified Data.Time.Clock as Time +import qualified Data.Validation as V +import Reflex.Dom (Event, MonadWidget, Reflex) +import qualified Reflex.Dom as R +import qualified Text.Read as T + +import Common.Model (Category (..), CreatePayment (..), + Frequency (..), Payment (..)) +import qualified Common.Msg as Msg +import qualified Common.Util.Time as Time +import qualified Common.Validation.Payment as PaymentValidation +import Component (ButtonIn (..), InputIn (..), + InputOut (..), SelectIn (..), + SelectOut (..)) +import qualified Component as Component +import qualified Util.Ajax as Ajax +import qualified Util.Either as EitherUtil +import qualified Util.Validation as ValidationUtil +import qualified Util.WaitFor as WaitFor data AddIn t = AddIn { _addIn_categories :: [Category] - , _addIn_show :: Event t () + , _addIn_cancel :: Event t () } data AddOut t = AddOut @@ -43,48 +46,84 @@ view addIn = do R.divClass "addContent" $ do rec + let reset = R.leftmost + [ const "" <$> cancel + , const "" <$> addedPayment + , const "" <$> _addIn_cancel addIn + ] + name <- _inputOut_value <$> (Component.input - (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Name }) - (const () <$ addedPayment)) + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Payment_Name + , _inputIn_validation = PaymentValidation.name + }) + reset + validate) cost <- _inputOut_value <$> (Component.input - (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Cost }) - (const () <$ addedPayment)) + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.Payment_Cost + , _inputIn_validation = PaymentValidation.cost + }) + reset + validate) - currentDay <- liftIO $ Time.getCurrentTime >>= Time.timeToDay + currentDay <- do + d <- liftIO $ Time.getCurrentTime >>= Time.timeToDay + return . T.pack . Calendar.showGregorian $ d date <- _inputOut_value <$> (Component.input (Component.defaultInputIn { _inputIn_label = Msg.get Msg.Payment_Date - , _inputIn_initialValue = T.pack . Calendar.showGregorian $ currentDay + , _inputIn_initialValue = currentDay , _inputIn_inputType = "date" , _inputIn_hasResetButton = False + , _inputIn_validation = PaymentValidation.date }) - (const () <$ addedPayment)) + (const currentDay <$> reset) + validate) frequency <- _selectOut_value <$> (Component.select $ SelectIn { _selectIn_label = Msg.get Msg.Payment_Frequency , _selectIn_initialValue = Punctual , _selectIn_values = R.constDyn frequencies - , _selectIn_reset = _addIn_show addIn + , _selectIn_reset = reset + , _selectIn_isValid = const True + , _selectIn_validate = validate }) category <- _selectOut_value <$> (Component.select $ SelectIn { _selectIn_label = Msg.get Msg.Payment_Category - , _selectIn_initialValue = 0 + , _selectIn_initialValue = -1 , _selectIn_values = R.constDyn categories - , _selectIn_reset = _addIn_show addIn + , _selectIn_reset = reset + , _selectIn_isValid = \id -> id /= -1 + , _selectIn_validate = validate }) - let payment = CreatePayment - <$> name - <*> fmap (Maybe.fromMaybe 0 . T.readMaybe . T.unpack) cost - <*> fmap (Maybe.fromMaybe currentDay . Time.parseDay) date - <*> category - <*> frequency - - (addedPayment, cancel) <- R.divClass "buttons" $ do + let payment = do + n <- name + c <- cost + d <- date + cat <- category + f <- frequency + pure $ do + n' <- n + c' <- c + d' <- d + pure $ CreatePayment + <$> ValidationUtil.nelError n' + <*> ValidationUtil.nelError c' + <*> ValidationUtil.nelError d' + <*> ValidationUtil.nelError (V.Success cat) + <*> ValidationUtil.nelError (V.Success f) + + (addedPayment, cancel, validate) <- R.divClass "buttons" $ do rec + cancel <- Component._buttonOut_clic <$> (Component.button $ + (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo)) + { _buttonIn_class = R.constDyn "undo" }) + validate <- Component._buttonOut_clic <$> (Component.button $ (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm)) { _buttonIn_class = R.constDyn "confirm" @@ -94,13 +133,9 @@ view addIn = do (result, waiting) <- WaitFor.waitFor (Ajax.postJson "/payment") - (R.tag (R.current payment) validate) - - cancel <- Component._buttonOut_clic <$> (Component.button $ - (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo)) - { _buttonIn_class = R.constDyn "undo" }) + (ValidationUtil.fireValidation payment validate) - return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel) + return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel, validate) return AddOut { _addOut_cancel = cancel diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs index 6fbaecf..56441eb 100644 --- a/client/src/View/Payment/Header.hs +++ b/client/src/View/Payment/Header.hs @@ -97,18 +97,19 @@ payerAndAdd incomes payments users categories currency = do , _buttonIn_submit = False }) rec - modalOut <- fmap _modalOut_content . Component.modal $ ModalIn + modalOut <- Component.modal $ ModalIn { _modalIn_show = addPaymentClic , _modalIn_hide = R.leftmost $ - [ _addOut_cancel modalOut - , fmap (const ()) . _addOut_addedPayment $ modalOut + [ _addOut_cancel addOut + , fmap (const ()) . _addOut_addedPayment $ addOut ] , _modalIn_content = Add.view $ AddIn { _addIn_categories = categories - , _addIn_show = addPaymentClic + , _addIn_cancel = _modalOut_hide modalOut } } - return (_addOut_addedPayment modalOut) + let addOut = _modalOut_content modalOut + return (_addOut_addedPayment addOut) searchLine :: forall t m. MonadWidget t m @@ -116,9 +117,10 @@ searchLine -> m (Dynamic t Text, Dynamic t Frequency) searchLine reset = do R.divClass "searchLine" $ do - searchName <- _inputOut_value <$> (Component.input + searchName <- _inputOut_raw <$> (Component.input ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name }) - reset) + (const "" <$> reset) + R.never) let frequencies = M.fromList [ (Punctual, Msg.get Msg.Payment_PunctualMale) diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs index 57d67ac..cbe7b50 100644 --- a/client/src/View/Payment/Pages.hs +++ b/client/src/View/Payment/Pages.hs @@ -47,7 +47,7 @@ pageButtons total perPage reset = do , pageClic , nextPageClic , lastPageClic - , (const 1) <$> reset + , 1 <$ reset ] firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs index 428997e..6fbf6d6 100644 --- a/client/src/View/SignIn.hs +++ b/client/src/View/SignIn.hs @@ -3,20 +3,24 @@ module View.SignIn , view ) where -import qualified Data.Either as Either -import Data.Text (Text) -import Prelude hiding (error) -import Reflex.Dom (Event, MonadWidget) -import qualified Reflex.Dom as R +import qualified Data.Either as Either +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import Data.Validation (Validation) +import Prelude hiding (error) +import Reflex.Dom (Event, MonadWidget) +import qualified Reflex.Dom as R -import Common.Model (SignIn (SignIn)) -import qualified Common.Msg as Msg +import Common.Model (SignInForm (SignInForm)) +import qualified Common.Msg as Msg +import qualified Common.Validation.SignIn as SignInValidation -import Component (ButtonIn (..), ButtonOut (..), InputIn (..), - InputOut (..)) -import qualified Component as Component -import qualified Util.Ajax as Ajax -import qualified Util.WaitFor as WaitFor +import Component (ButtonIn (..), ButtonOut (..), + InputIn (..), InputOut (..)) +import qualified Component as Component +import qualified Util.Ajax as Ajax +import qualified Util.Validation as ValidationUtil +import qualified Util.WaitFor as WaitFor data SignInMessage = SuccessMessage Text @@ -29,19 +33,27 @@ view signInMessage = Component.form $ do rec input <- (Component.input - (Component.defaultInputIn { _inputIn_label = Msg.get Msg.SignIn_EmailLabel }) - (R.ffilter Either.isRight signInResult)) + (Component.defaultInputIn + { _inputIn_label = Msg.get Msg.SignIn_EmailLabel + , _inputIn_validation = SignInValidation.email + }) + (const "" <$> R.ffilter Either.isRight signInResult) + validate) - button <- Component.button $ + validate <- _buttonOut_clic <$> (Component.button $ (Component.defaultButtonIn (R.text $ Msg.get Msg.SignIn_Button)) { _buttonIn_class = R.constDyn "validate" , _buttonIn_waiting = waiting , _buttonIn_submit = True - } + }) + + let form = SignInForm <$> _inputOut_raw input (signInResult, waiting) <- WaitFor.waitFor - (\email -> Ajax.postJson "/askSignIn" (SignIn <$> email)) - (R.tag (R.current (_inputOut_value input)) (_buttonOut_clic button)) + (Ajax.postJson "/askSignIn") + (ValidationUtil.fireMaybe + ((\f -> const f <$> SignInValidation.signIn f) <$> form) + validate) showSignInResult signInMessage signInResult diff --git a/common/common.cabal b/common/common.cabal index 78f2927..9881c64 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -20,19 +20,26 @@ Library OverloadedStrings Build-depends: - aeson - , base >=4.9 && <5 + aeson + , base >= 4.11 && < 5 , text , time + , validation Exposed-modules: Common.Model Common.Model.CreatePayment + Common.Model.Email Common.Model.Payment + Common.Model.SignInForm Common.Model.User Common.Msg Common.Util.Text Common.Util.Time + Common.Util.Validation + Common.Validation.Atomic + Common.Validation.Payment + Common.Validation.SignIn Common.View.Format other-modules: @@ -52,4 +59,3 @@ Library Common.Model.InitResult Common.Model.Payer Common.Model.PaymentCategory - Common.Model.SignIn diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs index 6e5f246..4acba93 100644 --- a/common/src/Common/Message/Key.hs +++ b/common/src/Common/Message/Key.hs @@ -39,6 +39,7 @@ data Key = | Form_AlreadyExists | Form_NonEmpty + | Form_MinChars Int | Form_NonNullNumber | Form_GreaterIntThan Int | Form_InvalidCategory diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs index 70eb978..e95fa74 100644 --- a/common/src/Common/Message/Translation.hs +++ b/common/src/Common/Message/Translation.hs @@ -162,6 +162,11 @@ m l Form_NonEmpty = English -> "Required field" French -> "Champ requis" +m l (Form_MinChars number) = + case l of + English -> T.concat [ "This field must contains at least ", T.pack . show $ number, " characters" ] + French -> T.concat [ "Ce champ doit contenir au moins ", T.pack . show $ number, " caractères" ] + m l Form_NonNullNumber = case l of English -> "Number must not be null" @@ -184,8 +189,8 @@ m l Form_InvalidColor = m l Form_InvalidDate = case l of - English -> "day/month/year required" - French -> "jour/mois/année requis" + English -> "DD/MM/YYYY required" + French -> "JJ/MM/AAAA requis" m l Form_InvalidInt = case l of diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs index cb38b2f..b0e0491 100644 --- a/common/src/Common/Model.hs +++ b/common/src/Common/Model.hs @@ -8,6 +8,7 @@ import Common.Model.Currency as X import Common.Model.EditCategory as X import Common.Model.EditIncome as X import Common.Model.EditPayment as X +import Common.Model.Email as X import Common.Model.Frequency as X import Common.Model.Income as X import Common.Model.Init as X @@ -15,5 +16,5 @@ import Common.Model.InitResult as X import Common.Model.Payer as X import Common.Model.Payment as X import Common.Model.PaymentCategory as X -import Common.Model.SignIn as X +import Common.Model.SignInForm as X import Common.Model.User as X diff --git a/common/src/Common/Model/Email.hs b/common/src/Common/Model/Email.hs new file mode 100644 index 0000000..e938f83 --- /dev/null +++ b/common/src/Common/Model/Email.hs @@ -0,0 +1,12 @@ +module Common.Model.Email + ( Email(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Email = Email Text deriving (Show, Generic) + +instance FromJSON Email +instance ToJSON Email diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignInForm.hs index bfd7fbc..2b8c955 100644 --- a/common/src/Common/Model/SignIn.hs +++ b/common/src/Common/Model/SignInForm.hs @@ -1,14 +1,14 @@ -module Common.Model.SignIn - ( SignIn(..) +module Common.Model.SignInForm + ( SignInForm(..) ) where import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) -data SignIn = SignIn +data SignInForm = SignInForm { _signIn_email :: Text } deriving (Show, Generic) -instance FromJSON SignIn -instance ToJSON SignIn +instance FromJSON SignInForm +instance ToJSON SignInForm 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 diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs new file mode 100644 index 0000000..3516668 --- /dev/null +++ b/common/src/Common/Validation/Atomic.hs @@ -0,0 +1,47 @@ +module Common.Validation.Atomic + ( nonEmpty + , minLength + , number + , nonNullNumber + , day + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as V +import qualified Text.Read as T + +import qualified Common.Msg as Msg +import qualified Common.Util.Time as Time + +minLength :: Int -> Text -> Validation Text Text +minLength l = + V.validate + (Msg.get (Msg.Form_MinChars l)) + (\t -> if T.length t >= l then Just t else Nothing) + +nonEmpty :: Text -> Validation Text Text +nonEmpty = + V.validate + (Msg.get Msg.Form_NonEmpty) + (\t -> if (not . T.null $ t) then Just t else Nothing) + +number :: Text -> Validation Text Int +number input = + case (T.readMaybe . T.unpack $ input) of + Just n -> V.Success n + _ -> V.Failure (Msg.get Msg.Form_InvalidInt) + +nonNullNumber :: Int -> Validation Text Int +nonNullNumber = + V.validate + (Msg.get Msg.Form_NonNullNumber) + (\n -> if n /= 0 then Just n else Nothing) + +day :: Text -> Validation Text Day +day str = + case Time.parseDay str of + Just d -> V.Success d + Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs new file mode 100644 index 0000000..b6c1d30 --- /dev/null +++ b/common/src/Common/Validation/Payment.hs @@ -0,0 +1,21 @@ +module Common.Validation.Payment + ( name + , cost + , date + ) where + +import Data.Text (Text) +import Data.Time.Calendar (Day) +import Data.Validation (Validation) +import qualified Data.Validation as Validation + +import qualified Common.Validation.Atomic as Atomic + +name :: Text -> Validation Text Text +name = Atomic.nonEmpty + +cost :: Text -> Validation Text Int +cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber + +date :: Text -> Validation Text Day +date = Atomic.day diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs new file mode 100644 index 0000000..18ceb44 --- /dev/null +++ b/common/src/Common/Validation/SignIn.hs @@ -0,0 +1,19 @@ +module Common.Validation.SignIn + ( signIn + , email + ) where + +import Data.Text (Text) +import Data.Validation (Validation) + +import Common.Model.Email (Email (..)) +import Common.Model.SignInForm (SignInForm (..)) +import qualified Common.Validation.Atomic as Atomic +import qualified Data.Validation as Validation + +signIn :: SignInForm -> Maybe Email +signIn (SignInForm str) = + Validation.validation (const Nothing) Just . email $ str + +email :: Text -> Validation Text Email +email = fmap Email . Atomic.minLength 5 diff --git a/default.nix b/default.nix index e34d5bc..977af02 100644 --- a/default.nix +++ b/default.nix @@ -4,19 +4,20 @@ let reflex-platform = import (pkgs.fetchFromGitHub { owner = "reflex-frp"; repo = "reflex-platform"; - rev = "7e002c573a3d7d3224eb2154ae55fc898e67d211"; - sha256 = "1adhzvw32zahybwd6hn1fmqm0ky2x252mshscgq2g1qlks915436"; + rev = "51e02339704b7502e63bccf10a72fa4dda744b17"; + sha256 = "1mkimidf755968xzbm3z222xgpdvgg6xmmrfppv1hw0rap5w53iw"; }) {}; in reflex-platform.project ({ pkgs, ... }: { packages = { + validation = ./validation; common = ./common; server = ./server; client = ./client; }; shells = { - ghc = [ "common" "server" ]; - ghcjs = [ "common" "client" ]; + ghc = [ "validation" "common" "server" ]; + ghcjs = [ "validation" "common" "client" ]; }; }) diff --git a/server/server.cabal b/server/server.cabal index 644f57a..d6c4a9b 100644 --- a/server/server.cabal +++ b/server/server.cabal @@ -20,8 +20,8 @@ Executable server OverloadedStrings Build-depends: - aeson - , base >=4.9 && <5 + aeson + , base >= 4.11 && < 5 , base64-bytestring , blaze-builder , blaze-html @@ -32,7 +32,6 @@ Executable server , config-manager , containers , cookie - , email-validate , filepath , http-conduit , http-types diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs index 0b276d3..fbda527 100644 --- a/server/src/Controller/Index.hs +++ b/server/src/Controller/Index.hs @@ -9,18 +9,18 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as Json import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Time.Clock (diffUTCTime, getCurrentTime) -import Network.HTTP.Types.Status (badRequest400, ok200) +import qualified Network.HTTP.Types.Status as Status import Prelude hiding (error) import Web.Scotty (ActionM) import qualified Web.Scotty as S -import Common.Model (InitResult (..), SignIn (..), - User (..)) +import Common.Model (Email (..), InitResult (..), + SignInForm (..), User (..)) import Common.Msg (Key) import qualified Common.Msg as Msg +import qualified Common.Validation.SignIn as SignInValidation import Conf (Conf (..)) import qualified LoginSession @@ -30,7 +30,6 @@ import qualified Persistence.Init as InitPersistence import qualified Persistence.User as UserPersistence import qualified Secure import qualified SendMail -import qualified Text.Email.Validate as Email import qualified View.Mail.SignIn as SignIn import View.Page (page) @@ -45,10 +44,12 @@ get conf = do liftIO . Query.run . fmap InitSuccess $ InitPersistence.getInit user conf S.html $ page initResult -askSignIn :: Conf -> SignIn -> ActionM () -askSignIn conf (SignIn email) = - if Email.isValid (TE.encodeUtf8 email) - then do +askSignIn :: Conf -> SignInForm -> ActionM () +askSignIn conf form = + case SignInValidation.signIn form of + Nothing -> + textKey Status.badRequest400 Msg.SignIn_EmailInvalid + Just (Email email) -> do maybeUser <- liftIO . Query.run $ UserPersistence.get email case maybeUser of Just user -> do @@ -62,9 +63,8 @@ askSignIn conf (SignIn email) = maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email] case maybeSentMail of Right _ -> S.json (Json.String . Msg.get $ Msg.SignIn_EmailSent) - Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail - Nothing -> textKey badRequest400 Msg.Secure_Unauthorized - else textKey badRequest400 Msg.SignIn_EmailInvalid + Left _ -> textKey Status.badRequest400 Msg.SignIn_EmailSendFail + Nothing -> textKey Status.badRequest400 Msg.Secure_Unauthorized where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key) trySignIn :: Conf -> Text -> ActionM () @@ -116,4 +116,4 @@ getLoggedUser = do liftIO . Query.run . Secure.getUserFromToken $ token signOut :: Conf -> ActionM () -signOut conf = LoginSession.delete conf >> S.status ok200 +signOut conf = LoginSession.delete conf >> S.status Status.ok200 diff --git a/server/src/Design/Form.hs b/server/src/Design/Form.hs index 0385cb4..31a2127 100644 --- a/server/src/Design/Form.hs +++ b/server/src/Design/Form.hs @@ -22,7 +22,7 @@ design = do ".textInput" ? do position relative - marginBottom (em 1.5) + marginBottom (em 2) paddingTop (px inputTop) marginTop (px (-10)) @@ -46,7 +46,7 @@ design = do position absolute top (px inputTop) left (px 0) - transition "all" (sec 0.2) easeIn (sec 0) + transition "all" (sec 0.2) easeInOut (sec 0) button ? do position absolute @@ -110,11 +110,13 @@ design = do fontWeight bold ".selectInput" ? do - marginBottom (em 1) + marginBottom (em 2) + label ? do display block marginBottom (px 10) fontSize (pct 80) + select ? do width (pct 100) backgroundColor Color.white @@ -122,6 +124,8 @@ design = do sym borderRadius (px 3) sym2 padding (px 5) (px 8) option ? sym2 padding (px 5) (px 8) + focus & backgroundColor Color.wildSand + ".error" & do select ? borderColor Color.chestnutRose ".errorMessage" ? do diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs index ba4ccb7..66e9f47 100644 --- a/server/src/Design/Global.hs +++ b/server/src/Design/Global.hs @@ -3,6 +3,7 @@ module Design.Global ) where import Clay +import Clay.Color as C import Data.Text.Lazy (Text) import qualified Design.Color as Color @@ -26,8 +27,16 @@ global = do Views.design Form.design + spinKeyframes + appearKeyframe + + html ? do + height (pct 100) + body ? do + position relative minWidth (px 320) + height (pct 100) fontFamily ["Cantarell"] [sansSerif] ".modal" & overflowY hidden @@ -40,6 +49,28 @@ global = do button ? fontSize (px 14) input ? fontSize (px 14) + ".app" ? do + appearAnimation + + ".spinner" ? do + display flex + alignItems center + justifyContent center + width (pct 100) + height (pct 100) + paddingBottom (pct 10) + + before & do + display block + content (stringContent "") + width (px 50) + height (px 50) + border solid (px 3) (C.setA 0.3 Color.chestnutRose) + sym borderRadius (pct 50) + borderTopColor Color.chestnutRose + spinKeyframes + spinAnimation + a ? cursor pointer input ? fontSize inherit @@ -87,21 +118,31 @@ global = do opacity 0 svg # ".loader" ? do opacity 1 - rotateKeyframes - rotateAnimation + spinAnimation select ? cursor pointer -rotateAnimation :: Css -rotateAnimation = do +spinAnimation :: Css +spinAnimation = do animationName "rotate" animationDuration (sec 1) - animationTimingFunction easeOut + animationTimingFunction easeInOut animationIterationCount infinite -rotateKeyframes :: Css -rotateKeyframes = keyframes +spinKeyframes :: Css +spinKeyframes = keyframes "rotate" - [ (0, "transform" -: "rotate(0deg)") - , (100, "transform" -: "rotate(360deg)") + [ (100, "transform" -: "rotate(360deg)") + ] + +appearAnimation :: Css +appearAnimation = do + animationName "appear" + animationDuration (sec 0.2) + animationTimingFunction easeIn + +appearKeyframe :: Css +appearKeyframe = keyframes + "appear" + [ (0, "opacity" -: "0") ] diff --git a/server/src/Design/Modal.hs b/server/src/Design/Modal.hs index 914c011..9c016b9 100644 --- a/server/src/Design/Modal.hs +++ b/server/src/Design/Modal.hs @@ -23,7 +23,7 @@ design = do transition "all" (sec 0.2) ease (sec 0) ".modalContent" ? do - minWidth (px 270) + minWidth (px 300) position fixed top (pct 25) left (pct 50) diff --git a/server/src/Design/View/Header.hs b/server/src/Design/View/Header.hs index 97f1802..2422686 100644 --- a/server/src/Design/View/Header.hs +++ b/server/src/Design/View/Header.hs @@ -56,6 +56,8 @@ design = do ".signOut" ? do display flex + justifyContent center + alignItems center svg ? do Media.tabletDesktop $ width (px 30) Media.mobile $ width (px 20) diff --git a/server/src/Design/View/Payment/Add.hs b/server/src/Design/View/Payment/Add.hs index 199ad36..5ecae7a 100644 --- a/server/src/Design/View/Payment/Add.hs +++ b/server/src/Design/View/Payment/Add.hs @@ -14,12 +14,12 @@ design = do backgroundColor Color.chestnutRose fontSize (px 18) color Color.white - sym padding (px 20) + sym2 padding (px 20) (px 30) textAlign (alignSide sideCenter) borderRadius (px 5) (px 5) (px 0) (px 0) ".addContent" ? do - sym padding (px 20) + sym2 padding (px 20) (px 30) ".buttons" ? do display flex @@ -30,3 +30,6 @@ design = do Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten ".undo" ? Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten + + (".confirm" <> ".undo") ? + width (px 90) diff --git a/server/src/Design/View/Payment/Delete.hs b/server/src/Design/View/Payment/Delete.hs index 5597f5b..f3d7e3f 100644 --- a/server/src/Design/View/Payment/Delete.hs +++ b/server/src/Design/View/Payment/Delete.hs @@ -30,3 +30,6 @@ design = do Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten ".undo" ? Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten + + (".confirm" <> ".undo") ? + width (px 90) diff --git a/server/src/Validation/Atomic.hs b/server/src/Validation/Atomic.hs index d15ad49..7a7351a 100644 --- a/server/src/Validation/Atomic.hs +++ b/server/src/Validation/Atomic.hs @@ -19,7 +19,7 @@ nonNullNumber :: Int -> Maybe Text nonNullNumber n = if n == 0 then Just $ Msg.get Msg.Form_NonNullNumber - else Nothing + else Nothing -- number :: (Int -> Bool) -> Text -> Maybe Int -- number numberForm str = diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs index 97b84fa..f47c544 100644 --- a/server/src/View/Page.hs +++ b/server/src/View/Page.hs @@ -31,6 +31,9 @@ page initResult = link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css" link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png" H.style $ toHtml globalDesign + H.body $ do + H.div ! A.class_ "spinner" $ "" + jsonScript :: Json.ToJSON a => Text -> a -> Html jsonScript scriptId json = diff --git a/validation/LICENSE b/validation/LICENSE new file mode 100644 index 0000000..45644ff --- /dev/null +++ b/validation/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/validation/Setup.hs b/validation/Setup.hs new file mode 100644 index 0000000..4467109 --- /dev/null +++ b/validation/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/validation/validation.cabal b/validation/validation.cabal new file mode 100644 index 0000000..6e2458b --- /dev/null +++ b/validation/validation.cabal @@ -0,0 +1,23 @@ +name: validation +version: 1 +license: BSD3 +license-file: LICENCE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart> +maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>, Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ> +synopsis: A data-type like Either but with an accumulating Applicative +category: Data +cabal-version: >= 1.10 +build-type: Simple + +library + Default-Language: Haskell2010 + Build-Depends: + base >= 4.5 && < 5 + , deepseq >= 1.2 && < 1.5 + , semigroups >= 0.8 && < 1 + , semigroupoids >= 5 && < 6 + , bifunctors >= 5.1 && < 6 + , lens >= 4 && < 5 + Ghc-Options: -Wall + Hs-Source-Dirs: src + Exposed-Modules: Data.Validation |