domain-core (empty) → 0.1

raw patch · 8 files changed

+334/−0 lines, 8 filesdep +basedep +template-haskelldep +template-haskell-compat-v0208setup-changed

Dependencies added: base, template-haskell, template-haskell-compat-v0208, text, th-lego, th-lift-instances

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• domain-core.cabal +38/−0
• library/DomainCore/Deriver.hs +36/−0
• library/DomainCore/Model.hs +59/−0
• library/DomainCore/Prelude.hs +93/−0
• library/DomainCore/TH.hs +60/−0
• library/DomainCore/Text.hs +24/−0

@@ -0,0 +1,22 @@+Copyright (c) 2020 Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,38 @@+name: domain-core+version: 0.1+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 <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2020 Nikita Volkov+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10++source-repository head+  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+  exposed-modules:+    DomainCore.Deriver+    DomainCore.Model+    DomainCore.TH+  other-modules:+    DomainCore.Prelude+    DomainCore.Text+  build-depends:+    base >=4.12 && <5,+    text >=1 && <2,+    template-haskell >=2.13 && <3,+    template-haskell-compat-v0208 >=0.1.5 && <0.2,+    th-lego >=0.2.3 && <0.3,+    th-lift-instances >=0.1.17 && <0.2

@@ -0,0 +1,36 @@+{-|+Toolkit for definition of instance derivers for Domain specs.+-}+module DomainCore.Deriver+(+  -- * 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.++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'.+-}+effectless f =+  Deriver (pure . f)

@@ -0,0 +1,59 @@+{-|+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+  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)] +  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+  deriving (Generic, Show, Eq, Ord, Lift)

@@ -0,0 +1,93 @@+module DomainCore.Prelude+( +  module Exports,+  showAsText,+)+where++-- base+-------------------------+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.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+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.Compose as Exports+import Data.Functor.Contravariant as Exports+import Data.Int as Exports+import Data.IORef 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.Maybe as Exports+import Data.Monoid as Exports hiding (Alt)+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+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.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import GHC.OverloadedLabels as Exports+import GHC.Records as Exports+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)+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+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 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 ()++showAsText :: Show a => a -> Text+showAsText = show >>> fromString

@@ -0,0 +1,60 @@+module DomainCore.TH+where++import DomainCore.Prelude+import DomainCore.Model+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.+-}+typeType ::+  {-| Model type. -}+  Type ->+  {-| Template Haskell type. -}+  TH.Type+typeType =+  \ case+    AppType a ->+      foldl1 TH.AppT (fmap typeType a)+    RefType a ->+      TH.ConT (TH.textName a)+    ListType a ->+      TH.AppT TH.ListT (typeType a)+    TupleType a ->+      TH.multiAppT (TH.TupleT (length a)) (fmap typeType a)++{-|+Assemble a record field name.+-}+recordFieldName ::+  {-| Prepend with underscore. -}+  Bool ->+  {-| Prefix with type name. -}+  Bool ->+  {-| Type name. -}+  Text ->+  {-| Label. -}+  Text ->+  {-| Template Haskell name. -}+  TH.Name+recordFieldName underscore prefixWithTypeName a b =+  TH.textName (Text.recordField underscore prefixWithTypeName a b)++{-|+Assemble a sum constructor name.+-}+sumConstructorName ::+  {-| Type name. -}+  Text ->+  {-| Label. -}+  Text ->+  {-| Template Haskell name. -}+  TH.Name+sumConstructorName a b =+  TH.textName (Text.sumConstructor a b)

@@ -0,0 +1,24 @@+module DomainCore.Text+where++import DomainCore.Prelude+import Data.Text+import qualified Data.Char as Char+++recordField underscore prefixWithTypeName a b =+  bool mempty "_" underscore <>+  bool b (lcFirst a <> ucFirst b) prefixWithTypeName++sumConstructor a b =+  ucFirst b <> a++mapFirstChar fn =+  foldMap (\ (a, b) -> cons (fn a) b) .+  uncons++ucFirst =+  mapFirstChar Char.toUpper++lcFirst =+  mapFirstChar Char.toLower