vervis/src/Vervis/Ops.hs

{- This file is part of Vervis.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}

module Vervis.Ops
    ( saveState
    , createUser
    )
where

import Control.Monad (join)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class
import Data.Aeson
import Data.CaseInsensitive (CI)
import Data.Foldable (toList)
import Data.Git
import Data.Git.Revision
import Data.Git.Repository
import Data.Hashable (Hashable)
import Data.HashMap.Lazy (HashMap)
import Data.HashSet (HashSet)
import Data.Hourglass
import Data.JsonState
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Data.Time.Units
import GHC.Generics
import System.Directory.Tree hiding (name, file, err)
import System.FilePath ((</>))
import System.Hourglass (dateCurrent)
import Vervis.Monad
import Vervis.Types

import qualified Control.Monad.Trans.RWS as RWS
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Lazy as M
import qualified Data.Text as T

saveState :: Vervis ()
saveState = do
    save <- asks veSave
    vstate <- get
    save vstate

createUser :: User -> Vervis ()
createUser user = do
    vstate <- get
    let users = vsUsers vstate
        next = vsNextUser vstate
        users' = M.insert next user users
        next' = UserID $ unUserID next + 1
    put vstate { vsUsers = users', vsNextUser = next' }
    saveState