diff --git a/domain-core.cabal b/domain-core.cabal --- a/domain-core.cabal +++ b/domain-core.cabal @@ -1,38 +1,82 @@ -name: domain-core -version: 0.1.0.3 -synopsis: Low-level API of "domain" +cabal-version: 3.0 +name: domain-core +version: 0.1.0.4 +synopsis: Low-level API of "domain" description: Use this package for defining extensions to \"domain\". Primarily derivers. -homepage: https://github.com/nikita-volkov/domain-core -bug-reports: https://github.com/nikita-volkov/domain-core/issues -author: Nikita Volkov -maintainer: Nikita Volkov -copyright: (c) 2020 Nikita Volkov -license: MIT -license-file: LICENSE -build-type: Simple -cabal-version: >=1.10 +category: IDL +homepage: https://github.com/nikita-volkov/domain-core +bug-reports: https://github.com/nikita-volkov/domain-core/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2020 Nikita Volkov +license: MIT +license-file: LICENSE + source-repository head - type: git + type: git location: git://github.com/nikita-volkov/domain-core.git library - hs-source-dirs: library - default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveLift, DerivingVia, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedLabels, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators - default-language: Haskell2010 + hs-source-dirs: library + default-extensions: + NoImplicitPrelude + NoMonomorphismRestriction + BangPatterns + BlockArguments + ConstraintKinds + DataKinds + DefaultSignatures + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingVia + EmptyDataDecls + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + LambdaCase + LiberalTypeSynonyms + MagicHash + MultiParamTypeClasses + MultiWayIf + OverloadedLabels + OverloadedStrings + ParallelListComp + PatternGuards + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + StrictData + TemplateHaskell + TupleSections + TypeApplications + TypeFamilies + TypeOperators + + default-language: Haskell2010 exposed-modules: DomainCore.Deriver DomainCore.Model DomainCore.TH + other-modules: DomainCore.Prelude DomainCore.Text + build-depends: - base >=4.12 && <5, - text >=1 && <3, - template-haskell >=2.13 && <3, - template-haskell-compat-v0208 >=0.1.5 && <0.2, - th-lego >=0.3.0.1 && <0.4, - th-lift-instances >=0.1.17 && <0.2 + , base >=4.12 && <5 + , template-haskell >=2.13 && <3 + , text >=1 && <3 + , th-lego >=0.3.0.1 && <0.4 + , th-lift-instances >=0.1.17 && <0.2 diff --git a/library/DomainCore/Deriver.hs b/library/DomainCore/Deriver.hs --- a/library/DomainCore/Deriver.hs +++ b/library/DomainCore/Deriver.hs @@ -1,36 +1,32 @@ -{-| -Toolkit for definition of instance derivers for Domain specs. --} +-- | +-- Toolkit for definition of instance derivers for Domain specs. module DomainCore.Deriver -( - -- * Deriver definitions - Deriver(..), - effectless, -) + ( -- * Deriver definitions + Deriver (..), + effectless, + ) where -import DomainCore.Prelude import DomainCore.Model -import qualified Language.Haskell.TH as TH (Q, Dec) - - -{-| -Specification of which instances to automatically derive for all the -supported types in the model and how. +import DomainCore.Prelude +import qualified Language.Haskell.TH as TH (Dec, Q) -You can combine derivers using Monoid and Semigroup. --} -newtype Deriver = - {-| - Function from the type declaration in this package\'s own AST - to a list of Template Haskell declarations in its quotation monad. - -} - Deriver (TypeDec -> TH.Q [TH.Dec]) - deriving (Semigroup, Monoid) +-- | +-- Specification of which instances to automatically derive for all the +-- supported types in the model and how. +-- +-- You can combine derivers using Monoid and Semigroup. +newtype Deriver + = -- | + -- Function from the type declaration in this package\'s own AST + -- to a list of Template Haskell declarations in its quotation monad. + Deriver (TypeDec -> TH.Q [TH.Dec]) + deriving + (Semigroup, Monoid) via ((->) TypeDec (Ap TH.Q [TH.Dec])) -{-| -Lift a pure function, which doesn't require the context of 'TH.Q'. --} +-- | +-- Lift a pure function, which doesn't require the context of 'TH.Q'. +effectless :: (TypeDec -> [TH.Dec]) -> Deriver effectless f = Deriver (pure . f) diff --git a/library/DomainCore/Model.hs b/library/DomainCore/Model.hs --- a/library/DomainCore/Model.hs +++ b/library/DomainCore/Model.hs @@ -1,59 +1,46 @@ -{-| -High-level model of schema. --} -module DomainCore.Model -where +-- | +-- High-level model of schema. +module DomainCore.Model where import DomainCore.Prelude - -{-| -Declaration of a type. --} -data TypeDec = - {-| - Name of the type and its definition. - -} - TypeDec Text TypeDef +-- | +-- Declaration of a type. +data TypeDec + = -- | + -- Name of the type and its definition. + TypeDec Text TypeDef deriving (Generic, Show, Eq, Ord, Lift) -{-| -Definition of a type. --} -data TypeDef = - {-| - Sum. - A list of pairs of names of its members - (which will be mapped to constructors) and - types which will populate the according constructors. - -} - SumTypeDef [(Text, [Type])] | - {-| - Product. - Think of it as a record. - Carries a list of associations of field names with types. - -} - ProductTypeDef [(Text, Type)] +-- | +-- Definition of a type. +data TypeDef + = -- | + -- Sum. + -- A list of pairs of names of its members + -- (which will be mapped to constructors) and + -- types which will populate the according constructors. + SumTypeDef [(Text, [Type])] + | -- | + -- Product. + -- Think of it as a record. + -- Carries a list of associations of field names with types. + ProductTypeDef [(Text, Type)] deriving (Generic, Show, Eq, Ord, Lift) -{-| -Type. --} -data Type = - {-| - Fully applied tuple of the listed types. - -} - TupleType [Type] | - {-| - List of type applications. - -} - AppType (NonEmpty Type) | - {-| - List type with the type of its element. - -} - ListType Type | - {-| - Possibly qualified reference to another type. - -} - RefType Text +-- | +-- Type. +data Type + = -- | + -- Fully applied tuple of the listed types. + TupleType [Type] + | -- | + -- List of type applications. + AppType (NonEmpty Type) + | -- | + -- List type with the type of its element. + ListType Type + | -- | + -- Possibly qualified reference to another type. + RefType Text deriving (Generic, Show, Eq, Ord, Lift) diff --git a/library/DomainCore/Prelude.hs b/library/DomainCore/Prelude.hs --- a/library/DomainCore/Prelude.hs +++ b/library/DomainCore/Prelude.hs @@ -1,21 +1,18 @@ module DomainCore.Prelude -( - module Exports, - showAsText, -) + ( module Exports, + showAsText, + ) where --- base -------------------------- -import Control.Applicative as Exports hiding (WrappedArrow(..)) +import Control.Applicative as Exports hiding (WrappedArrow (..)) import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports -import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM) -import Control.Monad.IO.Class as Exports +import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix) +import Control.Monad.IO.Class as Exports import Control.Monad.ST as Exports import Data.Bifunctor as Exports import Data.Bits as Exports @@ -29,14 +26,14 @@ import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports +import Data.Functor as Exports hiding (unzip) import Data.Functor.Compose as Exports import Data.Functor.Contravariant as Exports -import Data.Int as Exports import Data.IORef as Exports +import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl') -import Data.List.NonEmpty as Exports (NonEmpty(..)) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt) import Data.Ord as Exports @@ -44,6 +41,7 @@ import Data.Ratio as Exports import Data.STRef as Exports import Data.String as Exports +import Data.Text as Exports (Text) import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports @@ -55,14 +53,15 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports -import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) -import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith) +import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) +import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import GHC.OverloadedLabels as Exports import GHC.Records as Exports +import Instances.TH.Lift as Exports () +import Language.Haskell.TH.Syntax as Exports (Lift) import Numeric as Exports -import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose) @@ -71,23 +70,10 @@ import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports -import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P) -import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec) -import Text.Printf as Exports (printf, hPrintf) -import Text.Read as Exports (Read(..), readMaybe, readEither) +import Text.Printf as Exports (hPrintf, printf) +import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports - --- text -------------------------- -import Data.Text as Exports (Text) - --- template-haskell -------------------------- -import Language.Haskell.TH.Syntax as Exports (Lift) - --- th-lift-instances -------------------------- -import Instances.TH.Lift as Exports () +import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) -showAsText :: Show a => a -> Text +showAsText :: (Show a) => a -> Text showAsText = show >>> fromString diff --git a/library/DomainCore/TH.hs b/library/DomainCore/TH.hs --- a/library/DomainCore/TH.hs +++ b/library/DomainCore/TH.hs @@ -1,25 +1,20 @@ -module DomainCore.TH -where +module DomainCore.TH where -import DomainCore.Prelude import DomainCore.Model +import DomainCore.Prelude +import qualified DomainCore.Text as Text import qualified Language.Haskell.TH as TH import qualified THLego.Helpers as TH -import qualified DomainCore.Text as Text -import qualified Data.Text as Text -import qualified Data.Char as Char - -{-| -Convert a model type definition into Template Haskell. --} +-- | +-- Convert a model type definition into Template Haskell. typeType :: - {-| Model type. -} + -- | Model type. Type -> - {-| Template Haskell type. -} + -- | Template Haskell type. TH.Type typeType = - \ case + \case AppType a -> foldl1 TH.AppT (fmap typeType a) RefType a -> @@ -29,32 +24,30 @@ TupleType a -> TH.multiAppT (TH.TupleT (length a)) (fmap typeType a) -{-| -Assemble a record field name. --} +-- | +-- Assemble a record field name. recordFieldName :: - {-| Prepend with underscore. -} + -- | Prepend with underscore. Bool -> - {-| Prefix with type name. -} + -- | Prefix with type name. Bool -> - {-| Type name. -} + -- | Type name. Text -> - {-| Label. -} + -- | Label. Text -> - {-| Template Haskell name. -} + -- | Template Haskell name. TH.Name recordFieldName underscore prefixWithTypeName a b = TH.textName (Text.recordField underscore prefixWithTypeName a b) -{-| -Assemble a sum constructor name. --} +-- | +-- Assemble a sum constructor name. sumConstructorName :: - {-| Type name. -} + -- | Type name. Text -> - {-| Label. -} + -- | Label. Text -> - {-| Template Haskell name. -} + -- | Template Haskell name. TH.Name sumConstructorName a b = TH.textName (Text.sumConstructor a b) diff --git a/library/DomainCore/Text.hs b/library/DomainCore/Text.hs --- a/library/DomainCore/Text.hs +++ b/library/DomainCore/Text.hs @@ -1,24 +1,27 @@ -module DomainCore.Text -where +module DomainCore.Text where -import DomainCore.Prelude -import Data.Text import qualified Data.Char as Char - +import Data.Text +import DomainCore.Prelude +recordField :: Bool -> Bool -> Text -> Text -> Text recordField underscore prefixWithTypeName a b = - bool mempty "_" underscore <> - bool b (lcFirst a <> ucFirst b) prefixWithTypeName + bool mempty "_" underscore + <> bool b (lcFirst a <> ucFirst b) prefixWithTypeName +sumConstructor :: Text -> Text -> Text sumConstructor a b = ucFirst b <> a +mapFirstChar :: (Char -> Char) -> Text -> Text mapFirstChar fn = - foldMap (\ (a, b) -> cons (fn a) b) . - uncons + foldMap (\(a, b) -> cons (fn a) b) + . uncons +ucFirst :: Text -> Text ucFirst = mapFirstChar Char.toUpper +lcFirst :: Text -> Text lcFirst = mapFirstChar Char.toLower