From b7c0cd8fbef6147bf1ff2e30abfcf5c4c025862b Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 25 Feb 2022 16:30:45 +0100
Subject: server: write out adjusted maps

---
 server/Server.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

(limited to 'server/Server.hs')

diff --git a/server/Server.hs b/server/Server.hs
index 711da88..46a1c8c 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -28,12 +28,12 @@ module Server ( loadConfig
               , ServerState, emptyState, unState
               , JobStatus(..)
               , setJobStatus
-              , prettySha,getJobStatus) where
+              , prettySha,getJobStatus,adjustedPath) where
 
 import           Universum
 
 import           CheckDir                   (DirResult)
-import           CheckMap                   (ResultKind (Full, Shrunk))
+import           CheckMap                   (ResultKind (Shrunk))
 import           Control.Arrow              ((>>>))
 import           Control.Concurrent         (modifyMVar_, withMVar)
 import           Crypto.Hash.SHA1           (hash)
@@ -90,6 +90,7 @@ data Org (loaded :: Bool) = Org
   { orgSlug       :: Text
   , orgLintconfig :: ConfigRes loaded LintConfig'
   , orgEntrypoint :: FilePath
+  , orgGeneration :: Int
   , orgRepos      :: [RemoteRef]
   , orgUrl        :: Text
   , orgWebdir     :: Text
@@ -123,7 +124,7 @@ data Config (loaded :: Bool) = Config
   , _verbose   :: Bool
   , _interval  :: Int
   -- ^ port to bind to
-  , _exneuland :: BaseUrl
+  , _exneuland :: Maybe BaseUrl
   , _token     :: Maybe Text
   , _orgs      :: [Org loaded]
   } deriving Generic
@@ -142,6 +143,7 @@ orgCodec = Org
   <$> T.text "slug" .= orgSlug
   <*> T.string "lintconfig" .= orgLintconfig
   <*> T.string "entrypoint" .= orgEntrypoint
+  <*> T.int "generation" .= orgGeneration
   <*> T.list remoteCodec "repo" .= orgRepos
   <*> T.text "url" .= orgUrl
   <*> T.text "webdir" .= orgWebdir
@@ -158,7 +160,7 @@ configCodec = Config
     <*> T.int "port" .= _port
     <*> T.bool "verbose" .= _verbose
     <*> T.int "interval" .= _interval
-    <*> T.match (urlBimap >>> T._String) "exneuland" .= _exneuland
+    <*> coerce (T.first (T.match (urlBimap >>> T._String)) "exneuland") .= _exneuland
     -- First is just Maybe but with different semantics
     <*> coerce (T.first T.text "token") .= _token
     <*> T.list orgCodec "org" .= _orgs
@@ -221,3 +223,9 @@ setJobStatus mvar !org !ref !status = do
 getJobStatus :: MVar ServerState -> Text -> Sha1 -> IO (Maybe (RemoteRef, JobStatus))
 getJobStatus mvar orgslug sha = withMVar mvar $ \state ->
   pure (M.lookup sha (view (unState . ix (Org { orgSlug = orgslug })) state))
+
+-- | the path (relative to a baseurl / webdir) where an adjusted
+-- map should go
+adjustedPath :: Text -> Org True -> Text -- TODO: filepath library using Text?
+adjustedPath rev Org {..} =
+  orgWebdir <> "/" <> (rev <> show orgGeneration)
-- 
cgit v1.2.3