exigo-schema 0.1.0.0 → 0.2.0.0
raw patch · 7 files changed
+84/−18 lines, 7 filesdep +QuickCheckdep +directorydep +exceptionsdep ~base
Dependencies added: QuickCheck, directory, exceptions, exigo-schema, hint, hspec, hspec-core, interpolate, quickcheck-text, temporary
Dependency ranges changed: base
Files
- ChangeLog.md +7/−0
- README.md +5/−0
- config/exigo.persistentmodels +3/−3
- exigo-schema.cabal +46/−4
- src/Exigo/Persistent/Schema.hs +14/−7
- src/Exigo/Persistent/TH/Internal.hs +8/−4
- test/Spec.hs +1/−0
ChangeLog.md view
@@ -2,6 +2,13 @@ ## Unreleased changes +## 0.2.0.0 changes++- Bug fixes+- Instances of FromJSON and ToJSON have changed - field names now+ don't repeat the entity name (i.e., `Student` has field `name`,+ rather than `studentName`).+ ## 0.1.0.0 - initial release
README.md view
@@ -1,5 +1,10 @@ # exigo-schema +[](https://travis-ci.org/phlummox/exigo-schema)+[](https://ci.appveyor.com/project/phlummox/exigo-schema)+[](https://hackage.haskell.org/package/exigo-schema)+[](LICENSE)+ Database schema for assessment/marking programs. Plus a few Template Haskell utility functions for adding to the schema
config/exigo.persistentmodels view
@@ -1,5 +1,5 @@ -Student+Student json studNo Text Primary studNo name Text@@ -7,7 +7,7 @@ deriving Eq deriving Generic -Submission+Submission json student StudentId Primary student studentLogin Text@@ -16,7 +16,7 @@ deriving Eq deriving Generic -LatePenalty+LatePenalty json student StudentId Primary student daysLate Int
exigo-schema.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: exigo-schema-version: 0.1.0.0+version: 0.2.0.0 category: Database synopsis: database schema for exigo marking/assessment tools description: Please see the README on GitHub at <https://github.com/phlummox/exigo-schema#readme>@@ -17,6 +17,10 @@ README.md ChangeLog.md config/exigo.persistentmodels+-- builds & tests successfully as far back as stack lts-7+tested-with: GHC == 8.0.1+ GHC == 8.2.2+ GHC == 8.6.5 source-repository head type: git@@ -42,7 +46,45 @@ , th-lift-instances default-language: Haskell2010 ghc-options:- -Wall -Wextra -Wcompat -Wincomplete-record-updates- -Wincomplete-uni-patterns -Wredundant-constraints -fwarn-tabs- -Wno-name-shadowing -Wno-type-defaults+ -Wall+ -fwarn-tabs+ -Wredundant-constraints+ -Wno-type-defaults+ -Wcompat+ -Wextra+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wno-name-shadowing+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.8)+ ghc-options: -Wmissing-deriving-strategies + -- could add: -fenable-th-splice-warnings++test-suite exigo-schema-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , exigo-schema+ , directory+ , exceptions+ , hint+ , hspec+ , hspec-core+ , interpolate+ , persistent+ , persistent-template+ -- , process+ -- ^^ used for debugging+ , quickcheck-text+ , QuickCheck+ , temporary+ , template-haskell+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010
src/Exigo/Persistent/Schema.hs view
@@ -12,6 +12,20 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} +-- other extensions, needed to compile+-- for recent persistent-template versions++{-# LANGUAGE CPP #-}++#if MIN_VERSION_persistent_template(2,7,2)+{-# LANGUAGE UndecidableInstances #-}+#endif++#if MIN_VERSION_persistent_template(2,8,0)+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE StandaloneDeriving #-}+#endif+ {- | Basic database schema for exigo tools.@@ -69,11 +83,4 @@ instance Binary Submission where instance Binary LatePenalty where -instance FromJSON Student where-instance FromJSON Submission where-instance FromJSON LatePenalty where--instance ToJSON Student where-instance ToJSON Submission where-instance ToJSON LatePenalty where
src/Exigo/Persistent/TH/Internal.hs view
@@ -18,6 +18,7 @@ , FieldType(FTTypeCon) , HaskellName(..) ) import Data.Char+import Data.Monoid ( (<>) ) import qualified Data.Text as T import Data.Text ( Text, cons, uncons ) import Database.Persist.TH ( MkPersistSettings(..) )@@ -42,7 +43,7 @@ let name = mkName name' mData <- lift mData' return [ SigD name $ ConT ''AssessmentMetadata- , FunD name [normalClause [] mData]+ , ValD (VarP name) (NormalB mData) [] ] -- | create a function which returns all the question-type field@@ -60,9 +61,12 @@ -- where the accessors are in the order they appear -- in the EntityDef. mkQuestionFieldsAccessor :: MkPersistSettings -> String -> [EntityDef] -> Q [Dec]-mkQuestionFieldsAccessor mpSettings nm es =- let es' = filter isMarks es- in concat <$> mapM (mkAcc nm) es'+mkQuestionFieldsAccessor mpSettings nm es = do+ let es' = filter isMarks es+ case es' of+ [] -> error "no entities with name 'Marks' - did you call mkQuestionFieldsAccessor intentionally?"+ [_] -> concat <$> mapM (mkAcc nm) es'+ _ -> error "multiple entities with name 'Marks' - did you call mkQuestionFieldsAccessor intentionally?" where mkAcc :: String -> EntityDef -> Q [Dec]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}