Commit 8b6d6c5b authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Recognize development builds of decker more precisely

parent a0efe5ad
......@@ -27,10 +27,17 @@ import Text.Groom
import qualified Text.Mustache as M ()
import Text.Pandoc
import Text.Pandoc.Definition
import Text.Printf ()
import Text.Printf
main :: IO ()
main = do
when isDevelopmentVersion $
printf
"WARNING: You are running a development build of decker (version: %s, branch: %s, commit: %s, tag: %s). Please make sure that you know what you're doing.\n"
deckerVersion
deckerGitBranch
deckerGitCommitId
deckerGitVersionTag
extractResources
directories <- projectDirectories
--
......@@ -47,7 +54,13 @@ main = do
--
phony "version" $ do
putNormal $
"decker version " ++ deckerVersion ++ " (" ++ deckerGitBranch ++ ")"
"decker version " ++
deckerVersion ++
" (branch: " ++
deckerGitBranch ++
", commit: " ++
deckerGitCommitId ++
", tag: " ++ deckerGitVersionTag ++ ")"
putNormal $ "pandoc version " ++ pandocVersion
putNormal $ "pandoc-types version " ++ showVersion pandocTypesVersion
--
......
base-name := decker
executable := $(shell stack path | grep local-install-root | sed "s/local-install-root: //")/bin/decker
version := $(shell grep "version: " package.yaml | sed "s/version: *//")
branch := $(shell git branch | grep \* | cut -d ' ' -f2)
branch := $(shell git rev-parse --abbrev-ref HEAD)
commit := $(shell git rev-parse --short HEAD)
local-bin-path := $(HOME)/.local/bin
ifeq ($(branch),master)
decker-name := $(base-name)-$(version)
else
decker-name := $(base-name)-$(version)-$(branch)
endif
decker-name := $(base-name)-$(version)-$(branch)-$(commit)
resource-dir := $(HOME)/.local/share/$(decker-name)
ifdef DECKER_DEV
......@@ -73,6 +69,7 @@ install: yarn build
mkdir -p $(local-bin-path)
cp $(executable) "$(local-bin-path)/$(decker-name)"
ln -sf "$(decker-name)" $(local-bin-path)/$(base-name)
ln -sf "$(decker-name)" $(local-bin-path)/$(base-name)-$(version)
watch-resources:
find resource src-support -name "*.scss" -or -name "*.html" -or -name "*.js" | entr -pd make install-resources
......
name: decker
version: 0.7.3
license: OtherLicense
author: "Henrik Tramberend"
maintainer: "henrik.tramberend@beuth-hochschule.de"
copyright: "2018 Henrik Tramberend"
name: decker
version: 0.7.3
license: OtherLicense
author: "Henrik Tramberend"
maintainer: "henrik.tramberend@beuth-hochschule.de"
copyright: "2018 Henrik Tramberend"
build-type: Custom
custom-setup:
dependencies:
dependencies:
- base >= 4.7 && < 5
- bytestring
- Cabal
- conduit
- directory
- extra
- filepath
- Glob
- zip
extra-source-files:
- readme.md
- Dockerfile
- makefile
- src-support/*
- resource/template/*
- resource/example/*
synopsis: A markdown based tool for slide deck creation
category: Tool
description: Please see the README at <https://gitlab2.informatik.uni-wuerzburg.de/decker/decker#readme>
dependencies:
- base >= 4.7 && < 5
- aeson
- ansi-terminal
- array
- base64-bytestring
- blaze-html
- blaze-markup
- bytestring
- Cabal
- conduit
- containers
- data-default
- directory
- extra
- file-embed
- filepath
- fsnotify
- Glob
- groom
- hashable
- highlighting-kate
- HTTP
- http-conduit
- http-types
- lens
- lens-action
- lens-aeson
- MissingH
- monad-loops
- mtl
- multimap
- mustache
- network-uri
- pandoc
- pandoc-citeproc
- pandoc-lens
- pandoc-types
- process
- pureMD5
- random
- regex-tdfa
- scientific
- shake
- snap-core
- snap-server
- split
- template-haskell
- temporary
- text
- time
- transformers
- unordered-containers
- utf8-string
- vector
- websockets
- websockets-snap
- yaml
- zip
extra-source-files:
- readme.md
- Dockerfile
- makefile
- src-support/*
- resource/template/*
- resource/example/*
synopsis: A markdown based tool for slide deck creation
category: Tool
description: Please see the README at <https://gitlab2.informatik.uni-wuerzburg.de/decker/decker#readme>
dependencies:
- base >= 4.7 && < 5
- Glob
- MissingH
- HTTP
- aeson
- ansi-terminal
- array
- base64-bytestring
- blaze-html
- blaze-markup
- bytestring
- containers
- data-default
- directory
- extra
- file-embed
- filepath
- fsnotify
- groom
- hashable
- highlighting-kate
- http-conduit
- http-types
- lens
- lens-aeson
- lens-action
- monad-loops
- mtl
- multimap
- mustache
- network-uri
- pandoc
- pandoc-citeproc
- pandoc-lens
- pandoc-types
- process
- pureMD5
- random
- scientific
- shake
- snap-core
- snap-server
- split
- template-haskell
- temporary
- text
- time
- transformers
- unordered-containers
- utf8-string
- vector
- websockets
- websockets-snap
- yaml
- zip
library:
source-dirs: src
executables:
decker:
main: Decker.hs
source-dirs: app
main: Decker.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- decker
- decker
tests:
decker-test:
main: Spec.hs
source-dirs: test
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- decker
- hspec
- decker
- hspec
default-extensions:
- EmptyCase
- FlexibleContexts
- FlexibleInstances
- InstanceSigs
- MultiParamTypeClasses
- OverloadedStrings
- TupleSections
- DeriveDataTypeable
- TemplateHaskell
- MultiWayIf
default-extensions:
- DeriveDataTypeable
- EmptyCase
- FlexibleContexts
- FlexibleInstances
- InstanceSigs
- MultiParamTypeClasses
- MultiWayIf
- NoMonomorphismRestriction
- OverloadedStrings
- TemplateHaskell
- TupleSections
......@@ -13,6 +13,8 @@ module Common
, needFiles
, deckerVersion
, deckerGitBranch
, deckerGitCommitId
, deckerGitVersionTag
, isDevelopmentVersion
, addScript
, dropSuffix
......@@ -40,25 +42,50 @@ import qualified Data.List.Extra as List
import Data.Maybe
import qualified Data.Set as Set
import Data.Version (showVersion, versionBranch)
import Debug.Trace
import Development.Shake (Action, need)
import Network.URI as U
import Paths_decker (version)
import System.CPUTime
import Text.Printf
import Text.Read (readMaybe)
import Text.Regex.TDFA
-- | The version from the cabal file
deckerVersion :: String
deckerVersion = showVersion version
-- | Determine the git branch at compile time
-- | Determines the git branch at compile time
deckerGitBranch :: String
deckerGitBranch = $(lookupGitBranch)
-- | Is this a development or a production branch?
-- All branches are identified by three digits.
-- If the last digit is a zero, it is a production branch.
-- | Determines the git branch at compile time
deckerGitCommitId :: String
deckerGitCommitId = $(lookupGitCommitId)
-- | Determines the git tag at compile time
deckerGitVersionTag :: String
deckerGitVersionTag = $(lookupGitTag)
-- | Regex that matches a version tag
tagRegex = "v([0-9]+)[.]([0-9]+)[.]([0-9]+)" :: String
-- | Returns the tagged version as an array of strings.
deckerGitVersionTag' :: [String]
deckerGitVersionTag' =
case getAllTextSubmatches $ deckerGitVersionTag =~ tagRegex of
[] -> []
m:ms -> ms
isVersionTagMatching :: Bool
isVersionTagMatching =
versionBranch version == mapMaybe readMaybe deckerGitVersionTag'
-- | Is this a development or a production branch? Release versions are cut from
-- the master branch and carry a version tag (vX.Y.Z) that matches the version
-- entry in `package.yaml`. Everything else is a development version.
isDevelopmentVersion :: Bool
isDevelopmentVersion = deckerGitBranch /= "master"
isDevelopmentVersion = not (deckerGitBranch == "master" && isVersionTagMatching)
type Decker = StateT DeckerState Action
......
module CompileTime
( lookupGitBranch
, lookupGitCommitId
, lookupGitTag
) where
import Control.Monad
......@@ -15,6 +17,16 @@ lookupGitBranch =
(stringE . strip . fromMaybe "" <=< runIO . git)
["rev-parse", "--abbrev-ref", "HEAD"]
lookupGitCommitId :: Q Exp
lookupGitCommitId =
(stringE . strip . fromMaybe "" <=< runIO . git)
["rev-parse", "--short", "HEAD"]
lookupGitTag :: Q Exp
lookupGitTag =
(stringE . strip . fromMaybe "" <=< runIO . git)
["tag", "--points-at", "HEAD"]
git :: [String] -> IO (Maybe String)
git args = do
(exitCode, stdout, _) <- readProcessWithExitCode "git" args ""
......
......@@ -7,10 +7,10 @@ module Resources
) where
import Common
import Exception
import Control.Exception
import Control.Monad
import Control.Monad.Extra
import Exception
import System.Directory
import System.Environment
import System.Exit
......@@ -18,7 +18,11 @@ import System.FilePath
import System.Process
deckerResourceDir :: IO FilePath
deckerResourceDir = getXdgDirectory XdgData ("decker" ++ "-" ++ deckerVersion ++ "-" ++ deckerGitBranch)
deckerResourceDir =
getXdgDirectory
XdgData
("decker" ++
"-" ++ deckerVersion ++ "-" ++ deckerGitBranch ++ "-" ++ deckerGitCommitId)
getResourceString :: FilePath -> IO String
getResourceString path = do
......
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
module Server
( startHttpServer
, stopHttpServer
......@@ -9,8 +8,8 @@ module Server
import Control.Concurrent
import Control.Exception
import Control.Monad
import Control.Lens
import Control.Monad
import Data.Text
import Network.WebSockets
import Network.WebSockets.Snap
......@@ -65,7 +64,8 @@ runHttpServer :: MVar ServerState -> ProjectDirs -> Int -> IO ()
runHttpServer state dirs port = do
let documentRoot = dirs ^. public
config <- serverConfig dirs port
simpleHttpServe config $
handle (\(SomeException e) -> print e) $
simpleHttpServe config $
route
[ ("/reload", runWebSocketsSnap $ reloader state)
, ( "/reload.html" -- Just for testing the thing.
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment