1 {-# LANGUAGE OverloadedStrings, CPP #-} 2 module 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 JSON 17 import Model.Enum 18 import Model.Permission.Types 19 import Model.Release.Types 20 import Model.Metric 21 import Model.Category 22 import Model.Format 23 import Model.Party 24 import Model.Notification.Notice 25 import Web.Types 26 import 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