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