diff options
Diffstat (limited to 'server/Server.hs')
| -rw-r--r-- | server/Server.hs | 16 |
1 files changed, 12 insertions, 4 deletions
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) |