1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, RecordWildCards #-} 2 module Databrary.Model.Category 3 ( module Databrary.Model.Category.Types 4 , allCategories 5 , getCategory 6 , getCategory' 7 , categoryJSON 8 , participantCategory 9 ) where 10 11 import qualified Data.IntMap.Strict as IntMap 12 import Data.Monoid ((<>)) 13 import qualified Data.Text 14 15 import qualified Databrary.JSON as JSON 16 import Databrary.Model.Id 17 import Databrary.Model.Category.Types 18 19 -- Formerly used when loaded from db 20 -- categoryRow :: Selector -- Category 21 -- categoryRow = selectColumns 'Category "category" ["id", "name", "description"] 22 23 -- TODO: db coherence 24 allCategories :: [Category] 25 allCategories = 26 [Category 27 (Id 1) 28 (Data.Text.pack "participant") 29 (Just 30 (Data.Text.pack 31 "An individual human subject whose data are used or represented")), 32 Category 33 (Id 2) 34 (Data.Text.pack "pilot") 35 (Just 36 (Data.Text.pack 37 "Indicates that the methods used were not finalized or were non-standard")), 38 Category 39 (Id 3) 40 (Data.Text.pack "exclusion") 41 (Just (Data.Text.pack "Indicates that data were not usable")), 42 Category 43 (Id 4) 44 (Data.Text.pack "condition") 45 (Just 46 (Data.Text.pack 47 "An experimenter-determined manipulation (within or between sessions)")), 48 Category 49 (Id 5) 50 (Data.Text.pack "group") 51 (Just 52 (Data.Text.pack 53 "A grouping determined by an aspect of the data (participant ability, age, grade level, experience, longitudinal visit, measurements used/available)")), 54 Category 55 (Id 6) 56 (Data.Text.pack "task") 57 (Just 58 (Data.Text.pack 59 "A particular task, activity, or phase of the session or study")), 60 Category 61 (Id 7) 62 (Data.Text.pack "context") 63 (Just 64 (Data.Text.pack 65 "A particular setting or other aspect of where/when/how data were collected"))] 66 67 categoriesById :: IntMap.IntMap Category 68 categoriesById = IntMap.fromAscList $ map (\a -> (fromIntegral $ unId $ categoryId a, a)) allCategories 69 70 getCategory :: Id Category -> Maybe Category 71 getCategory (Id i) = IntMap.lookup (fromIntegral i) categoriesById 72 73 getCategory' :: Id Category -> Category 74 getCategory' (Id i) = categoriesById IntMap.! fromIntegral i 75 76 categoryJSON :: JSON.ToObject o => Category -> JSON.Record (Id Category) o 77 categoryJSON Category{..} = JSON.Record categoryId $ 78 "name" JSON..= categoryName 79 <> "description" `JSON.kvObjectOrEmpty` categoryDescription 80 81 participantCategory :: Category 82 participantCategory = head allCategories