1 {-# LANGUAGE OverloadedStrings, CPP #-} 2 module Databrary.Web.Constants 3 ( constantsJSON 4 , constantsJS 5 , generateConstantsJSON 6 , generateConstantsJS 7 ) where 8 9 import qualified Data.ByteString.Builder as BSB 10 import Data.Monoid ((<>)) 11 import qualified Data.Text as T 12 import Data.Version (showVersion) 13 import System.IO (withBinaryFile, IOMode(WriteMode)) 14 15 import Paths_databrary (version) 16 import qualified Databrary.JSON as JSON 17 import Databrary.Model.Enum 18 import Databrary.Model.Permission.Types 19 import Databrary.Model.Release.Types 20 import Databrary.Model.Metric 21 import Databrary.Model.Category 22 import Databrary.Model.Format 23 import Databrary.Model.Party 24 import Databrary.Model.Notification.Notice 25 import Databrary.Web.Types 26 import Databrary.Web.Generate 27 28 constantsJSON :: JSON.ToNestedObject o u => o 29 constantsJSON = 30 "permission" JSON..= enumValues PermissionPUBLIC 31 <> "release" JSON..= enumValues ReleasePUBLIC 32 <> "metric" JSON..=. JSON.recordMap (map metricJSON allMetrics) 33 <> "category" JSON..=. JSON.recordMap (map categoryJSON allCategories) 34 <> "format" JSON..=. JSON.recordMap (map formatJSON allFormats) 35 <> "party" JSON..=. 36 ( "nobody" JSON..=: partyJSON nobodyParty 37 <> "root" JSON..=: partyJSON rootParty 38 <> "staff" JSON..=: partyJSON staffParty 39 ) 40 <> "notice" JSON..= JSON.object [ T.pack (show n) JSON..= n | n <- [minBound..maxBound::Notice] ] 41 <> "delivery" JSON..= enumValues DeliveryNone 42 <> "version" JSON..= showVersion version 43 #ifdef DEVEL 44 <> "devel" JSON..= True 45 #endif 46 #ifdef SANDBOX 47 <> "sandbox" JSON..= True 48 #endif 49 -- TODO: url? 50 where 51 enumValues :: forall a . DBEnum a => a -> [String] 52 enumValues _ = map show $ enumFromTo minBound (maxBound :: a) 53 54 constantsJSONB :: BSB.Builder 55 constantsJSONB = JSON.fromEncoding $ JSON.pairs constantsJSON 56 57 constantsJS :: BSB.Builder 58 constantsJS = BSB.string8 "app.constant('constantData'," <> constantsJSONB <> BSB.string8 ");" 59 60 regenerateConstants :: BSB.Builder -> WebGenerator 61 regenerateConstants b = staticWebGenerate $ \f -> 62 withBinaryFile f WriteMode $ \h -> 63 BSB.hPutBuilder h b 64 65 generateConstantsJSON :: WebGenerator 66 generateConstantsJSON = regenerateConstants constantsJSONB 67 68 generateConstantsJS :: WebGenerator 69 generateConstantsJS = regenerateConstants constantsJS