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