model 0.4.1 → 0.4.2
raw patch · 6 files changed
+124/−59 lines, 6 filesdep +eitherdep ~basedep ~containersdep ~convertible
Dependencies added: either
Dependency ranges changed: base, containers, convertible, deepseq, doctest, filemanip, ghc-prim, pretty, tasty, tasty-hunit, tasty-quickcheck, transformers
Files
- CHANGELOG +8/−2
- model.cabal +15/−14
- src/Data/Model/Types.hs +57/−20
- src/Data/Model/Util.hs +42/−21
- stack.yaml +1/−1
- test/Spec.hs +1/−1
CHANGELOG view
@@ -1,5 +1,11 @@ Significant and compatibility-breaking changes. +Version 0.4.2:+ - model.cabal: added upper bounds for dependencies+ - Data.Model.Util: added error handling utilities++Version 0.4.1: Cosmetic changes to documentation+ Version 0.4: - Data.Model.Types: - Modified type of 'constructors' and 'constructorInfo'@@ -7,10 +13,10 @@ - Modified behaviour of conversion from String to QualName - Data.Model.Util: - modified type of 'mutualGroups' and 'transitiveClosure'+ - added some error handling utilities Version 0.3: - Data.Model.Util:- - Removed 'dependencies'- - Added the (similar but not identical) function 'transitiveClosure'+ - Removed 'dependencies', added (similar but not identical) 'transitiveClosure'
model.cabal view
@@ -1,5 +1,5 @@ name: model-version: 0.4.1+version: 0.4.2 synopsis: Derive a model of a data type using Generics description: See the <http://github.com/tittoassini/model online tutorial>. homepage: http://github.com/tittoassini/model@@ -29,11 +29,12 @@ , Data.Model.Util , Type.ANat,Type.Analyse build-depends: base >= 4.8 && < 5- , containers >= 0.5.6.2- , deepseq >= 1.4- , pretty >= 1.1.2.0- , transformers >= 0.4- , convertible >= 1.1.1.0 + , containers == 0.5.*+ , either > 4.3.2 && <5+ , deepseq == 1.4.*+ , transformers >= 0.4.2.0 && < 0.6+ , pretty >= 1.1.2 && < 1.2+ , convertible == 1.1.* default-language: Haskell2010 other-extensions: DataKinds, DefaultSignatures, DeriveAnyClass, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, NoMonomorphismRestriction, OverloadedStrings, PolyKinds, ScopedTypeVariables, TupleSections, TypeFamilies, TypeOperators, UndecidableInstances ghc-options: -Wall -fno-warn-orphans@@ -43,14 +44,14 @@ hs-source-dirs: test main-is: Spec.hs other-modules: Test.Data,Test.Data2,Test.Data3,Test.Data.Model,Info- build-depends: base >= 4.8 && < 5- , ghc-prim >= 0.3.1.0- , tasty >= 0.11.0.2- , tasty-hunit >= 0.9.2- , tasty-quickcheck >=0.8.4- , pretty >= 1.1.2.0- , containers >= 0.5.6.2+ build-depends: base+ , pretty+ , containers , model+ , ghc-prim+ , tasty >= 0.11 && < 0.13+ , tasty-hunit >= 0.8 && < 0.10+ , tasty-quickcheck >=0.8.1 && < 0.9.2 default-language: Haskell2010 @@ -59,5 +60,5 @@ type: exitcode-stdio-1.0 ghc-options: -threaded main-is: DocSpec.hs- build-depends: base >4 && <5, doctest>=0.11.1, filemanip>=0.3.6.3+ build-depends: base, doctest>=0.11.1 && <0.14,filemanip>=0.3.6.3 && < 0.3.7 HS-Source-Dirs: test
src/Data/Model/Types.hs view
@@ -34,12 +34,13 @@ import Control.Applicative import Control.DeepSeq-import Data.Bifunctor (first, second)-import qualified Data.Map as M+import Data.Bifunctor (first, second)+import Data.Either.Validation+import qualified Data.Map as M import Data.Maybe import Data.Model.Util import Data.Proxy-import Data.Word (Word8)+import Data.Word (Word8) import GHC.Generics -- |Haskell Environment@@ -270,28 +271,64 @@ data QualName = QualName {pkgName,mdlName,locName :: String} deriving (Eq, Ord, Show, NFData, Generic) --- |Return the qualified name, minus the package name.+{-|Return the qualified name, minus the package name.+>>> qualName (QualName {pkgName = "ab", mdlName = "cd.ef", locName = "gh"})+"cd.ef.gh"++-} qualName :: QualName -> String qualName n = convert $ n {pkgName=""} -instance Convertible String QualName where safeConvert = errorToConvertResult parseQualName+instance Convertible String QualName where safeConvert = errorsToConvertResult (validationToEither . asQualName)+ instance Convertible QualName String where safeConvert n = Right $ dotted [pkgName n,mdlName n,locName n] --- |Parse the string as a QualName, if possible------ >>> parseQualName "ab.cd.ef.gh"--- Right (QualName {pkgName = "ab", mdlName = "cd.ef", locName = "gh"})-parseQualName :: String -> Either String QualName-parseQualName "" = Left "Empty string"-parseQualName n = Right $- let (p,r) = span (/= '.') n- in if null r- then QualName "" "" p- else let (l,r2) = span (/= '.') $ reverse $ tail r- in if null r2- then QualName "" p (reverse l)- else let m = reverse $ tail r2- in QualName p m (reverse l)+{-|Convert a String to a `QualName`, if possible++>>> asQualName "ab.cd.ef.gh"+Success (QualName {pkgName = "ab", mdlName = "cd.ef", locName = "gh"})++>>> asQualName "ab.cd.ef"+Success (QualName {pkgName = "ab", mdlName = "cd", locName = "ef"})++>>> asQualName "ab.cd"+Success (QualName {pkgName = "", mdlName = "ab", locName = "cd"})++>>> asQualName "ab"+Success (QualName {pkgName = "", mdlName = "", locName = "ab"})++>>> asQualName ""+Failure ["Empty qualified name"]++>>> asQualName "."+Failure ["Empty qualified name"]++The conversion assumes that the input String is a well-formed Haskell fully qualified name.++It will produce funny results if this is not the case:++>>> asQualName "**.&&.!!"+Success (QualName {pkgName = "**", mdlName = "&&", locName = "!!"})++-}+asQualName :: String -> Validation Errors QualName+asQualName =+ (\n ->+ if nullQualName n+ then Failure ["Empty qualified name"]+ else Success n) .+ asQualName_+ where+ nullQualName n = pkgName n == "" && mdlName n == "" && locName n == ""+ asQualName_ n =+ let (p, r) = span (/= '.') n+ in if null r+ then QualName "" "" p+ else let (l, r2) = span (/= '.') $ reverse $ tail r+ in if null r2+ then QualName "" p (reverse l)+ else let m = reverse $ tail r2+ in QualName p m (reverse l) -- |Simple name data Name = Name String deriving (Eq, Ord, Show, NFData, Generic)
src/Data/Model/Util.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -11,15 +12,18 @@ , Errors , toErrors , noErrors- -- * Convertible utilities- , Convertible(..)- , convert- , ConvertResult- , ConvertError(..)+ , errsInContext+ , inContext , errorToConvertResult , errorsToConvertResult , convertResultToError , convertResultToErrors+ , convertOrError+ -- * Convertible re-exports+ , Convertible(..)+ , convert+ , ConvertResult+ , ConvertError(..) -- * Formatting utilities , dotted ) where@@ -90,36 +94,52 @@ type Error = String --- |Either an error or a valid value--- type EitherError a = Either String a---- |Either errors or a valid value--- type EitherErrors a = Either [String] a--toErrors :: Either Error a -> Either Errors a+toErrors :: Bifunctor p => p a c -> p [a] c toErrors = first (:[]) noErrors :: Errors -> Bool noErrors = null -errorToConvertResult- :: (Typeable b, Typeable a, Show a)- => (a -> Either Error b) -> a -> ConvertResult b+errorToConvertResult :: (Typeable b, Typeable a, Show a) => (a -> Either Error b) -> a -> ConvertResult b errorToConvertResult conv a = either (\err -> convError err a) Right $ conv a -errorsToConvertResult- :: (Typeable b, Typeable a, Show a)- => (a -> Either Errors b) -> a -> ConvertResult b-errorsToConvertResult conv a = either (\errs -> convError (unwords errs) a) Right $ conv a+{-|+>>> errorsToConvertResult (const (Left ["Bad format","Invalid value"])) ".." :: ConvertResult Int+Left (ConvertError {convSourceValue = "\"..\"", convSourceType = "[Char]", convDestType = "Int", convErrorMessage = "Bad format, Invalid value"})+-}+errorsToConvertResult :: (Typeable b, Typeable t, Show t) => (t -> Either Errors b) -> t -> ConvertResult b+errorsToConvertResult conv a = either (\errs -> convError (intercalate ", " errs) a) Right $ conv a -convertResultToError :: ConvertResult a -> Either Error a+{-|+>>> convertOrError 'a' :: Either Error Word+Right 97++>>> convertOrError (1E50::Double) :: Either Error Word+Left "Convertible: error converting source data 1.0e50 of type Double to type Word: Input value outside of bounds: (0,18446744073709551615)"+-}+convertOrError :: Convertible a c => a -> Either String c+convertOrError = convertResultToError . safeConvert++convertResultToError :: Bifunctor p => p ConvertError c -> p String c convertResultToError = first prettyConvertError -convertResultToErrors :: ConvertResult a -> Either Errors a+convertResultToErrors :: Bifunctor p => p ConvertError c -> p [String] c convertResultToErrors = toErrors . convertResultToError instance Convertible String String where safeConvert = Right . id +-- |Prefix errors with a contextual note+errsInContext :: (Convertible ctx String, Bifunctor p) => ctx -> p [String] c -> p [String] c+errsInContext ctx = first (inContext ctx)++{-|Prefix a list of strings with a contextual note++>>> inContext "0/0" ["Zero denominator"]+["In 0/0: Zero denominator"]+-}+inContext :: Convertible ctx String => ctx -> [String] -> [String]+inContext ctx = map (\msg -> unwords ["In",convert ctx++":",msg])+ {-| Intercalate a dot between the non empty elements of a list of strings. >>> dotted []@@ -138,3 +158,4 @@ dotted (h:t) = post h ++ dotted t where post s | null s = "" | otherwise = s ++ "."+
stack.yaml view
@@ -1,6 +1,6 @@ # resolver: lts-6.35 #resolver: lts-7.24-resolver: lts-9.11+resolver: lts-9.12 #resolver: nightly-2017-10-30 packages: - '.'
test/Spec.hs view
@@ -51,7 +51,7 @@ namesTests :: TestTree namesTests = testGroup "QualName Tests" [- tstErr "" "Empty string"+ tstErr "" "Empty qualified name" ,tst "ab" $ QualName "" "" "ab" --,tstErr "a.b.c.d" "Too many components in qualified name 'a.b.c.d'" ,tst "ab.cd" $ QualName "" "ab" "cd"