Types.purs
module Aftok.Types where
import Prelude
import Data.Argonaut.Decode (class DecodeJson, decodeJson, JsonDecodeError(..))
import Data.Date (Date, year, month, day)
import Data.DateTime (DateTime)
import Data.DateTime.Instant (Instant)
import Data.Either (note)
import Data.Enum (fromEnum)
import Data.JSDate as JD
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Data.Symbol (class IsSymbol, SProxy)
import Data.Tuple (Tuple(..))
import Data.UUID (UUID, toString, parseUUID)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Now (now, nowDateTime)
import Effect.Class.Console as C
import Type.Row as Row
import Web.Event.Event as WE
import Web.HTML (HTMLElement, window)
import Web.HTML.Window (location)
import Web.HTML.Location (href)
import Routing.Hash as RH
import Halogen as H
import Halogen.HTML as HH
import Halogen.Portal (portalAff)
import Aftok.Modals.ModalFFI as ModalFFI
import Aftok.HTML.QRious as QRious
type System m
= { href :: m String
, log :: String -> m Unit
, error :: String -> m Unit
, now :: m Instant
, getHash :: m String
, setHash :: String -> m Unit
, nowDateTime :: m DateTime
, preventDefault :: WE.Event -> m Unit
, dateFFI :: DateFFI m
, portal ::
forall query action input output slots label slot _1.
Row.Cons label (H.Slot query output slot) _1 slots =>
IsSymbol label =>
Ord slot =>
Monad m =>
SProxy label ->
slot ->
H.Component HH.HTML query input output m ->
input ->
Maybe HTMLElement ->
(output -> Maybe action) ->
H.ComponentHTML action slots m
, toggleModal :: String -> ModalFFI.Toggle -> m Unit
, renderQR :: QRious.QROpts -> m String
}
liveSystem :: System Aff
liveSystem =
{ href: liftEffect $ href =<< location =<< window
, log: liftEffect <<< C.log
, error: liftEffect <<< C.error
, now: liftEffect now
, getHash: liftEffect RH.getHash
, setHash: liftEffect <<< RH.setHash
, nowDateTime: liftEffect nowDateTime
, preventDefault: liftEffect <<< WE.preventDefault
, dateFFI: hoistDateFFI liftEffect jsDateFFI
, portal: portalAff
, toggleModal: \i t -> liftEffect (ModalFFI.toggleModal i t)
, renderQR: \opts -> liftEffect (QRious.renderQR opts)
}
type DateFFI m
= { midnightLocal :: Instant -> m (Maybe (Tuple Date Instant))
}
jsDateFFI :: DateFFI Effect
jsDateFFI =
{ midnightLocal
}
midnightLocal :: Instant -> Effect (Maybe (Tuple Date Instant))
midnightLocal i = do
let
jsDate = JD.fromInstant i
year <- JD.getFullYear jsDate
month <- JD.getMonth jsDate
day <- JD.getDate jsDate
jsMidnight <- midnightLocalJS year month day
let
date = JD.toDate jsMidnight
pure $ Tuple <$> date <*> JD.toInstant jsMidnight
midnightLocalJS :: Number -> Number -> Number -> Effect JD.JSDate
midnightLocalJS year month day =
JD.jsdateLocal
{ year
, month
, day
, hour: 0.0
, minute: 0.0
, second: 0.0
, millisecond: 0.0
}
hoistDateFFI :: forall m n. (forall a. m a -> n a) -> DateFFI m -> DateFFI n
hoistDateFFI nt ffi =
{ midnightLocal: \i -> nt (ffi.midnightLocal i)
}
newtype UserId
= UserId UUID
derive instance userIdEq :: Eq UserId
derive instance userIdOrd :: Ord UserId
derive instance userIdNewtype :: Newtype UserId _
instance userIdDecodeJson :: DecodeJson UserId where
decodeJson json = do
uuidStr <- decodeJson json
UserId <$> note (TypeMismatch "Failed to decode user UUID") (parseUUID uuidStr)
newtype ProjectId
= ProjectId UUID
derive instance projectIdEq :: Eq ProjectId
derive instance projectIdOrd :: Ord ProjectId
derive instance projectIdNewtype :: Newtype ProjectId _
instance projectIdDecodeJson :: DecodeJson ProjectId where
decodeJson json = do
uuidStr <- decodeJson json
ProjectId <$> note (TypeMismatch "Failed to decode project UUID") (parseUUID uuidStr)
pidStr :: ProjectId -> String
pidStr (ProjectId uuid) = toString uuid
dateStr :: Date -> String
dateStr d =
(show <<< fromEnum $ year d) <> "-"
<> (show <<< fromEnum $ month d)
<> "-"
<> (show <<< fromEnum $ day d)