NAFJ6RB3KYDBSTSNB3WQSVUQEPUGG2RZCBWRF4XNT2UKSOXDNMDQC
QH4UB73NUR2XPHZQ2RGJBKKUBN43RKC7ZJBCFPP4ESUIIEDDR5XQC
NJNMO72S7VIUV22JXB4IFPZMHWTJAOTP6EC6Z4QSKYIROSXT52MQC
SAESJLLYCQJUIHKFYFV53AWHFOSGI5SKLVS7DPTQO6BKGITPYPUQC
RSF6UAJKG7CEKILSVXI6C4YZXY7PIYZM2EMA2IXKQ7SADKNVSH7QC
QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC
WRPIYG3EUHZR6N6T74ZXZDXATRMIRLXAQ24UNUNSVTVYGMT2VDSQC
J6S23MDGHVSCVVIRB6XRNSY3EGTDNWFJHV7RYLIEHBUK5KU63CFQC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC
B4MTB6UOH5VPZQ7KDQ23TZSR3CIFGVGVBEFL26LMFAQ5RL7CXPRQC
OUR4PAOTXXKXQPMAR5TIYX7MBRRJS2WVTZS7SN4SOGML7SPJIJGQC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC
QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC
ARX7SHY5UXL5ZZDY4BJ6LVQSC2XCI5M6FFXQ35MBWDRUHNJNICHQC
RB2ETNIFLQUA6OA66DAEOXZ25ENMQGNKX5CZRSKEYHTD6BQ6NTFQC
AAALU5A2FQQTNV7ZVAFCU2JTRUONEUWWZKENDUUXDOFUGWHM3KZQC
O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC
BFZN4SUAGYNFFYVAP36BAX32DMO622PK4EPEVQQEAGC2IHTEAAPQC
module Aftok.Api.Json where
import Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (ExceptT, except, withExceptT)
import Control.Monad.Trans.Class (lift)
import Data.Argonaut.Core (Json)
import Data.Argonaut.Decode (class DecodeJson, decodeJson)
import Data.DateTime (DateTime)
import Data.DateTime.Instant (Instant, fromDateTime)
import Data.Functor.Compose (Compose(..))
import Data.Either (Either(..), note)
import Data.Foldable (class Foldable, foldr, foldl, foldMap)
import Data.JSDate as JD
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap, over)
import Data.Traversable (class Traversable, traverse)
import Effect (Effect)
import Affjax as AJAX
import Affjax (Response, printError)
import Affjax.StatusCode (StatusCode(..))
import Aftok.Api.Types (APIError(..))
newtype JsonCompose f g a
= JsonCompose (Compose f g a)
derive instance jsonComposeNewtype :: Newtype (JsonCompose f g a) _
instance jsonComposeFunctor :: (Functor f, Functor g) => Functor (JsonCompose f g) where
map f = over JsonCompose (map f)
instance jsonComposeFoldable :: (Foldable f, Foldable g) => Foldable (JsonCompose f g) where
foldr f b = foldr f b <<< unwrap
foldl f b = foldl f b <<< unwrap
foldMap f = foldMap f <<< unwrap
instance jsonComposeTraversable :: (Traversable f, Traversable g) => Traversable (JsonCompose f g) where
traverse f = map JsonCompose <<< traverse f <<< unwrap
sequence = traverse identity
instance jsonComposeDecodeJson :: (DecodeJson (f (g a))) => DecodeJson (JsonCompose f g a) where
decodeJson json = JsonCompose <<< Compose <$> decodeJson json
decompose :: forall f g a. JsonCompose f g a -> f (g a)
decompose (JsonCompose (Compose fga)) = fga
parseJsonDate :: Json -> ExceptT String Effect DateTime
parseJsonDate json = do
str <- except $ decodeJson json
parseDate str
parseDate :: String -> ExceptT String Effect DateTime
parseDate str = do
jsDate <- lift $ JD.parse str
except
$ note ("Unable to convert date " <> show jsDate <> " to a valid DateTime value.")
(JD.toDateTime jsDate)
decodeDatedJson :: forall t. Traversable t => DecodeJson (t String) => Json -> ExceptT String Effect (t DateTime)
decodeDatedJson json = do
decoded <- except $ decodeJson json
traverse parseDate decoded
parseDatedResponse ::
forall t.
Traversable t =>
DecodeJson (t String) =>
Either AJAX.Error (Response Json) ->
ExceptT APIError Effect (t Instant)
parseDatedResponse = case _ of
Left err -> throwError $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> throwError $ Forbidden
StatusCode 200 -> withExceptT (ParseFailure r.body) $ map fromDateTime <$> decodeDatedJson r.body
other -> throwError $ Error { status: Just other, message: r.statusText }
module Aftok.Api.Project where
import Prelude
import Control.Monad.Except.Trans (ExceptT, runExceptT, except, withExceptT)
import Control.Monad.Error.Class (throwError)
import Data.Argonaut.Core (Json)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
import Data.Bifunctor (lmap)
import Data.DateTime (DateTime)
import Data.Either (Either(..), note)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Rational (Rational)
import Data.Time.Duration (Hours)
import Data.Traversable (traverse)
import Data.UUID (UUID, parseUUID)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class as EC
import Affjax (get, printError)
import Affjax.StatusCode (StatusCode(..))
import Affjax.ResponseFormat as RF
import Aftok.Types
( UserId
, ProjectId(..)
)
import Aftok.Api.Types
( APIError(..) )
import Aftok.Api.Json (parseDate)
newtype Project' date
= Project'
{ projectId :: ProjectId
, projectName :: String
, inceptionDate :: date
, initiator :: UUID
}
derive instance newtypeProject :: Newtype (Project' a) _
type Project
= Project' DateTime
data ProjectEvent
= ProjectChange Project
instance decodeJsonProject :: DecodeJson (Project' String) where
decodeJson json = do
x <- decodeJson json
project <- x .: "project"
projectIdStr <- x .: "projectId"
projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiatorStr <- project .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectId, projectName, inceptionDate, initiator }
newtype Member' date
= Member'
{ userId :: UserId
, handle :: String
, joinedOn :: date
, timeDevoted :: Hours
, revShareFrac :: Rational
}
listProjects :: Aff (Either APIError (Array Project))
listProjects = do
result <- get RF.json "/api/projects"
EC.liftEffect <<< runExceptT
$ case result of
Left err -> throwError $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> throwError Forbidden
StatusCode 200 -> do
records <- except $ lmap (ParseFailure r.body) (decodeJson r.body)
traverse parseProject records
other -> throwError $ Error { status: Just other, message: r.statusText }
parseProject :: Json -> ExceptT APIError Effect Project
parseProject json = do
Project' p <- except <<< lmap (ParseFailure json) $ decodeJson json
pdate <- withExceptT (ParseFailure json) $ parseDate p.inceptionDate
pure $ Project' (p { inceptionDate = pdate })
module Aftok.Api.Types where
import Prelude
import Affjax.StatusCode (StatusCode)
import Data.Argonaut.Core (Json, stringify)
import Data.Maybe (Maybe)
data APIError
= Forbidden
| ParseFailure Json String
| Error { status :: Maybe StatusCode, message :: String }
instance showAPIError :: Show APIError where
show = case _ of
Forbidden -> "Forbidden"
ParseFailure js e -> "ParseFailure (" <> show (stringify js) <> ") " <> show e
Error r -> "Error { status: " <> show r.status <> ", message: " <> r.message <> "}"
listProjects :: Aff (Either APIError (Array Project))
listProjects = do
result <- get RF.json "/api/projects"
EC.liftEffect <<< runExceptT
$ case result of
Left err -> throwError $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> throwError Forbidden
StatusCode 200 -> do
records <- except $ lmap (ParseFailure r.body) (decodeJson r.body)
traverse parseProject records
other -> throwError $ Error { status: Just other, message: r.statusText }
parseProject :: Json -> ExceptT APIError Effect Project
parseProject json = do
Project' p <- except <<< lmap (ParseFailure json) $ decodeJson json
pdate <- withExceptT (ParseFailure json) $ parseDate p.inceptionDate
pure $ Project' (p { inceptionDate = pdate })
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (ExceptT, except, withExceptT)
import Control.Monad.Trans.Class (lift)
import Data.Argonaut.Core (Json, stringify)
import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
instance showAPIError :: Show APIError where
show = case _ of
Forbidden -> "Forbidden"
ParseFailure js e -> "ParseFailure (" <> show (stringify js) <> ") " <> show e
Error r -> "Error { status: " <> show r.status <> ", message: " <> r.message <> "}"
derive instance userIdNewtype :: Newtype UserId _
newtype Project' date
= Project'
{ projectId :: ProjectId
, projectName :: String
, inceptionDate :: date
, initiator :: UUID
}
derive instance newtypeProject :: Newtype (Project' a) _
type Project
= Project' DateTime
data ProjectEvent
= ProjectChange Project
instance decodeJsonProject :: DecodeJson (Project' String) where
decodeJson json = do
x <- decodeJson json
project <- x .: "project"
projectIdStr <- x .: "projectId"
projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiatorStr <- project .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectId, projectName, inceptionDate, initiator }
newtype JsonCompose f g a
= JsonCompose (Compose f g a)
derive instance jsonComposeNewtype :: Newtype (JsonCompose f g a) _
instance jsonComposeFunctor :: (Functor f, Functor g) => Functor (JsonCompose f g) where
map f = over JsonCompose (map f)
instance jsonComposeFoldable :: (Foldable f, Foldable g) => Foldable (JsonCompose f g) where
foldr f b = foldr f b <<< unwrap
foldl f b = foldl f b <<< unwrap
foldMap f = foldMap f <<< unwrap
instance jsonComposeTraversable :: (Traversable f, Traversable g) => Traversable (JsonCompose f g) where
traverse f = map JsonCompose <<< traverse f <<< unwrap
sequence = traverse identity
instance jsonComposeDecodeJson :: (DecodeJson (f (g a))) => DecodeJson (JsonCompose f g a) where
decodeJson json = JsonCompose <<< Compose <$> decodeJson json
decompose :: forall f g a. JsonCompose f g a -> f (g a)
decompose (JsonCompose (Compose fga)) = fga
parseJsonDate :: Json -> ExceptT String Effect DateTime
parseJsonDate json = do
str <- except $ decodeJson json
parseDate str
parseDate :: String -> ExceptT String Effect DateTime
parseDate str = do
jsDate <- lift $ JD.parse str
except
$ note ("Unable to convert date " <> show jsDate <> " to a valid DateTime value.")
(JD.toDateTime jsDate)
decodeDatedJson :: forall t. Traversable t => DecodeJson (t String) => Json -> ExceptT String Effect (t DateTime)
decodeDatedJson json = do
decoded <- except $ decodeJson json
traverse parseDate decoded
parseDatedResponse ::
forall t.
Traversable t =>
DecodeJson (t String) =>
Either AJAX.Error (Response Json) ->
ExceptT APIError Effect (t Instant)
parseDatedResponse = case _ of
Left err -> throwError $ Error { status: Nothing, message: printError err }
Right r -> case r.status of
StatusCode 403 -> throwError $ Forbidden
StatusCode 200 -> withExceptT (ParseFailure r.body) $ map fromDateTime <$> decodeDatedJson r.body
other -> throwError $ Error { status: Just other, message: r.statusText }