diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,10 @@ # exigo-schema +[![Build status](https://img.shields.io/travis/com/phlummox/exigo-schema.svg?logo=travis)](https://travis-ci.org/phlummox/exigo-schema) +[![Windows build status](https://ci.appveyor.com/api/projects/status/github/phlummox/exigo-schema?branch=master&svg=true)](https://ci.appveyor.com/project/phlummox/exigo-schema) +[![Hackage](https://img.shields.io/hackage/v/exigo-schema.svg?logo=haskell)](https://hackage.haskell.org/package/exigo-schema) +[![BSD-2-Clause license](https://img.shields.io/badge/license-BSD--2--Clause-blue.svg)](LICENSE) + Database schema for assessment/marking programs. Plus a few Template Haskell utility functions for adding to the schema diff --git a/config/exigo.persistentmodels b/config/exigo.persistentmodels --- a/config/exigo.persistentmodels +++ b/config/exigo.persistentmodels @@ -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 diff --git a/exigo-schema.cabal b/exigo-schema.cabal --- a/exigo-schema.cabal +++ b/exigo-schema.cabal @@ -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 @@ -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 diff --git a/src/Exigo/Persistent/Schema.hs b/src/Exigo/Persistent/Schema.hs --- a/src/Exigo/Persistent/Schema.hs +++ b/src/Exigo/Persistent/Schema.hs @@ -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 diff --git a/src/Exigo/Persistent/TH/Internal.hs b/src/Exigo/Persistent/TH/Internal.hs --- a/src/Exigo/Persistent/TH/Internal.hs +++ b/src/Exigo/Persistent/TH/Internal.hs @@ -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] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}