Reorganize modules

bin/Main.hs

@@ -6,24 +6,23 @@
 
 module Main (main) where
 
-import Codec.CBOR.Cuddle.CBOR.Gen (generateFromName)
-import Codec.CBOR.Cuddle.CBOR.Validator
-import Codec.CBOR.Cuddle.CBOR.Validator.Trace (
-  Evidenced (..),
-  SValidity (..),
-  TraceOptions (..),
-  prettyValidationTrace,
- )
 import Codec.CBOR.Cuddle.CDDL (CDDL, Name (..), fromRules, sortCDDL)
 import Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot)
-import Codec.CBOR.Cuddle.CDDL.Custom.Generator (GenConfig (..), runCBORGen)
 import Codec.CBOR.Cuddle.CDDL.Postlude (appendPostlude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
   fullResolveCDDL,
  )
+import Codec.CBOR.Cuddle.Generator (GenConfig (..), generateFromName, runCBORGen)
 import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..), mapCDDLDropExt)
-import Codec.CBOR.Cuddle.Parser (ParserStage, pCDDL)
-import Codec.CBOR.Cuddle.Pretty (PrettyStage, renderCDDL)
+import Codec.CBOR.Cuddle.Parser (ParserPhase, pCDDL)
+import Codec.CBOR.Cuddle.Pretty (PrettyPhase, renderCDDL)
+import Codec.CBOR.Cuddle.Validator (ValidatorPhase, validateCBOR)
+import Codec.CBOR.Cuddle.Validator.Trace (
+  Evidenced (..),
+  SValidity (..),
+  TraceOptions (..),
+  prettyValidationTrace,
+ )
 import Codec.CBOR.FlatTerm (toFlatTerm)
 import Codec.CBOR.Pretty (prettyHexEnc)
 import Codec.CBOR.Read (deserialiseFromBytes)
@@ -334,7 +333,7 @@ main = do
         )
   run options
 
-tryParseFromFile :: FilePath -> IO (CDDL ParserStage)
+tryParseFromFile :: FilePath -> IO (CDDL ParserPhase)
 tryParseFromFile cddlFile =
   parseFromFile pCDDL cddlFile >>= \case
     Left err -> do
@@ -371,7 +370,7 @@ run = \case
         | sort fOpts = fromRules $ sortCDDL res
         | otherwise = res
       layoutOptions = defaultLayoutOptions {layoutPageWidth = AvailablePerLine 80 1}
-      formattedText = renderCDDL layoutOptions $ mapIndex @_ @_ @PrettyStage defs
+      formattedText = renderCDDL layoutOptions $ mapIndex @_ @_ @PrettyPhase defs
     T.putStr formattedText
   Validate vOpts cddlFile -> do
     res <- tryParseFromFile cddlFile

cuddle.cabal

@@ -38,26 +38,29 @@ common warnings
 library
   import: warnings
   exposed-modules:
-    Codec.CBOR.Cuddle.CBOR.Gen
-    Codec.CBOR.Cuddle.CBOR.Validator
-    Codec.CBOR.Cuddle.CBOR.Validator.Trace
+    Codec.CBOR.Cuddle
+    Codec.CBOR.Cuddle.Generator
+    Codec.CBOR.Cuddle.Huddle
+    Codec.CBOR.Cuddle.Parser
+    Codec.CBOR.Cuddle.Validator
+
+  other-modules:
     Codec.CBOR.Cuddle.CDDL
     Codec.CBOR.Cuddle.CDDL.CTree
     Codec.CBOR.Cuddle.CDDL.CTreePhase
     Codec.CBOR.Cuddle.CDDL.CtlOp
-    Codec.CBOR.Cuddle.CDDL.Custom.Core
-    Codec.CBOR.Cuddle.CDDL.Custom.Generator
-    Codec.CBOR.Cuddle.CDDL.Custom.Validator
     Codec.CBOR.Cuddle.CDDL.Postlude
     Codec.CBOR.Cuddle.CDDL.Resolve
     Codec.CBOR.Cuddle.Comments
-    Codec.CBOR.Cuddle.Huddle
+    Codec.CBOR.Cuddle.Core
+    Codec.CBOR.Cuddle.Generator.Core
     Codec.CBOR.Cuddle.IndexMappable
-    Codec.CBOR.Cuddle.Parser
     Codec.CBOR.Cuddle.Parser.Lexer
     Codec.CBOR.Cuddle.Pretty
     Codec.CBOR.Cuddle.Pretty.Columnar
     Codec.CBOR.Cuddle.Pretty.Utils
+    Codec.CBOR.Cuddle.Validator.Core
+    Codec.CBOR.Cuddle.Validator.Trace
 
   build-depends:
     QuickCheck >=2.14.3,
@@ -128,17 +131,17 @@ test-suite cuddle-test
 
   other-modules:
     Paths_cuddle
-    Test.Codec.CBOR.Cuddle.CDDL.Examples
-    Test.Codec.CBOR.Cuddle.CDDL.Examples.Huddle
-    Test.Codec.CBOR.Cuddle.CDDL.Gen
-    Test.Codec.CBOR.Cuddle.CDDL.GeneratorSpec
-    Test.Codec.CBOR.Cuddle.CDDL.Parser
-    Test.Codec.CBOR.Cuddle.CDDL.Pretty
-    Test.Codec.CBOR.Cuddle.CDDL.Pretty.Golden
-    Test.Codec.CBOR.Cuddle.CDDL.TreeDiff
-    Test.Codec.CBOR.Cuddle.CDDL.Validator
-    Test.Codec.CBOR.Cuddle.CDDL.Validator.Golden
+    Test.Codec.CBOR.Cuddle.Examples
+    Test.Codec.CBOR.Cuddle.Examples.Huddle
+    Test.Codec.CBOR.Cuddle.Gen
+    Test.Codec.CBOR.Cuddle.GeneratorSpec
+    Test.Codec.CBOR.Cuddle.TreeDiff
     Test.Codec.CBOR.Cuddle.Huddle
+    Test.Codec.CBOR.Cuddle.Parser
+    Test.Codec.CBOR.Cuddle.Pretty
+    Test.Codec.CBOR.Cuddle.Pretty.Golden
+    Test.Codec.CBOR.Cuddle.Validator
+    Test.Codec.CBOR.Cuddle.Validator.Golden
 
   type: exitcode-stdio-1.0
   hs-source-dirs: test

example/Main.hs

@@ -5,18 +5,15 @@
 
 module Main (main) where
 
-import Codec.CBOR.Cuddle.CBOR.Gen (generateFromName)
-import Codec.CBOR.Cuddle.CDDL (Name (..))
-import Codec.CBOR.Cuddle.CDDL.Custom.Generator (GenConfig (..), runCBORGen)
-import Codec.CBOR.Cuddle.CDDL.Resolve (MonoSimplePhase, fullResolveCDDL)
+import Codec.CBOR.Cuddle (fullResolveCDDL, mapCDDLDropExt, mapIndex, showSimple)
+import Codec.CBOR.Cuddle.Generator (GenConfig (..), generateFromName, runCBORGen)
 import Codec.CBOR.Cuddle.Huddle (toCDDL)
-import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..), mapCDDLDropExt)
 import Codec.CBOR.Cuddle.Parser (pCDDL)
-import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Conway (conway)
+import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
-import Prettyprinter (Pretty (pretty))
+import Prettyprinter (Pretty (..))
 import Prettyprinter.Util (putDocW)
 import System.Environment (getArgs)
 import Test.AntiGen (runAntiGen)
@@ -31,14 +28,14 @@ main = do
       parseFromFile pCDDL fn >>= \case
         Left err -> putStrLn $ errorBundlePretty err
         Right res -> do
-          putDocW 80 $ pretty (mapIndex @_ @_ @PrettyStage res)
+          putDocW 80 $ pretty res
           putStrLn "\n"
           putStrLn "--------------------------------------------------------------------------------"
           putStrLn " Resolving"
           putStrLn "--------------------------------------------------------------------------------"
           case fullResolveCDDL (mapCDDLDropExt res) of
             Left nre -> putStrLn $ "Resolution error: " <> show nre
-            Right resolved -> print (mapIndex @_ @_ @MonoSimplePhase resolved)
+            Right resolved -> putStrLn $ showSimple resolved
     [fn, name] -> do
       putStrLn "--------------------------------------------------------------------------------"
       putStrLn " Generating a term"
@@ -50,11 +47,11 @@ main = do
             Left nre -> error $ show nre
             Right resolved -> do
               let cfg = GenConfig {gcRoot = mapIndex resolved, gcTwiddle = True}
-              term <- generate . runAntiGen . runCBORGen cfg $ generateFromName (Name (T.pack name))
+              term <- generate . runAntiGen . runCBORGen cfg $ generateFromName (fromString name)
               print term
     [] -> do
       let cw = toCDDL conway
-      putDocW 80 $ pretty (mapIndex @_ @_ @PrettyStage cw)
+      putDocW 80 $ pretty cw
     _ -> putStrLn "Expected filename"
 
 parseFromFile ::

src/Codec/CBOR/Cuddle.hs

@@ -0,0 +1,16 @@
+module Codec.CBOR.Cuddle (
+  -- * Resolver
+  fullResolveCDDL,
+
+  -- * IndexMap
+  mapCDDLDropExt,
+  IndexMappable (..),
+
+  -- * Prettyprinting
+  showSimple,
+  renderCDDL,
+) where
+
+import Codec.CBOR.Cuddle.CDDL.Resolve (fullResolveCDDL, showSimple)
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..), mapCDDLDropExt)
+import Codec.CBOR.Cuddle.Pretty (renderCDDL)

src/Codec/CBOR/Cuddle/CDDL.hs

@@ -39,7 +39,6 @@ module Codec.CBOR.Cuddle.CDDL (
   unwrap,
   compareRuleName,
   HasName (..),
-  GRef (..),
   -- Extension
   ForAllExtensions,
   XCddl,
@@ -51,14 +50,14 @@ module Codec.CBOR.Cuddle.CDDL (
 
 import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
 import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment, HasComment (..))
+import Codec.CBOR.Cuddle.Core (Name (..))
 import Data.ByteString qualified as B
 import Data.Default.Class (Default (..))
 import Data.Function (on)
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty (..), prependList)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (mapMaybe)
-import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.Word (Word64, Word8)
 import GHC.Base (Constraint, Type)
@@ -106,7 +105,7 @@ ruleTopLevel _ = Nothing
 
 -- | Sort the CDDL Rules on the basis of their names
 sortCDDL :: CDDL i -> NonEmpty (Rule i)
-sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` unName . ruleName) $ r :| mapMaybe ruleTopLevel rs
+sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` ruleName) $ r :| mapMaybe ruleTopLevel rs
 
 fromRules :: Monoid (XCddl i) => NonEmpty (Rule i) -> CDDL i
 fromRules (x :| xs) = CDDL x (TopLevelRule <$> xs) mempty
@@ -129,46 +128,6 @@ deriving instance ForAllExtensions i Eq => Eq (TopLevel i)
 
 deriving instance ForAllExtensions i Show => Show (TopLevel i)
 
--- |
---  A name can consist of any of the characters from the set {"A" to
---  "Z", "a" to "z", "0" to "9", "_", "-", "@", ".", "$"}, starting
---  with an alphabetic character (including "@", "_", "$") and ending
---  in such a character or a digit.
---
---  *  Names are case sensitive.
---
---  *  It is preferred style to start a name with a lowercase letter.
---
---  *  The hyphen is preferred over the underscore (except in a
---      "bareword" (Section 3.5.1), where the semantics may actually
---      require an underscore).
---
---  *  The period may be useful for larger specifications, to express
---      some module structure (as in "tcp.throughput" vs.
---      "udp.throughput").
---
---  *  A number of names are predefined in the CDDL prelude, as listed
---      in Appendix D.
---
---  *  Rule names (types or groups) do not appear in the actual CBOR
---      encoding, but names used as "barewords" in member keys do.
-newtype Name = Name {unName :: T.Text}
-  deriving (Generic)
-  deriving (Eq, Ord, Show)
-  deriving newtype (Semigroup, Monoid)
-
--- | A reference to a generic parameter inside the body of a generic rule.
-newtype GRef = GRef T.Text
-  deriving (Show)
-
-instance IsString Name where
-  fromString = Name . T.pack
-
-instance CollectComments Name where
-  collectComments _ = []
-
-instance Hashable Name
-
 class HasName a where
   getName :: a -> Name
 

src/Codec/CBOR/Cuddle/CDDL/CTree.hs

@@ -1,19 +1,33 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Codec.CBOR.Cuddle.CDDL.CTree where
 
-import Codec.CBOR.Cuddle.CDDL (Name, OccurrenceIndicator, RangeBound, Value)
+import Codec.CBOR.Cuddle.CDDL (
+  Name,
+  OccurrenceIndicator (..),
+  RangeBound (..),
+  Value (..),
+  ValueVariant (..),
+ )
 import Codec.CBOR.Cuddle.CDDL.CtlOp
+import Codec.CBOR.Cuddle.Core (GRef)
 import Control.Monad.Identity (Identity (..))
+import Data.Foldable (Foldable (..))
 import Data.Hashable (Hashable)
+import Data.Kind (Type)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
+import Data.Text (Text)
+import Data.Text qualified as T
 import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Generic.Random (genericArbitraryU)
+import Prettyprinter (Doc, Pretty (..), encloseSep, group, list, punctuate, tupled, vsep, (<+>))
 import Test.QuickCheck (Arbitrary (..))
 
 --------------------------------------------------------------------------------
@@ -85,6 +99,23 @@
   CTree j
 foldCTree atExt atNode x = runIdentity $ traverseCTree (pure . atExt) (pure . atNode) x
 
+displayCanonicalCTree :: CTree p -> Text
+displayCanonicalCTree = \case
+  Literal (Value v _) -> displayCanonicalValueVariant v
+  Postlude _ -> _
+  Map _ -> _
+  Array _ -> _
+  Choice _ -> _
+  Group _ -> _
+  KV _ _ _ -> _
+  Occur _ _ -> _
+  Range _ _ _ -> _
+  Control _ _ _ -> _
+  Enum _ -> _
+  Unwrap _ -> _
+  Tag _ _ -> _
+  CTreeE _ -> _
+
 type Node i = XXCTree i
 
 newtype CTreeRoot i = CTreeRoot (Map.Map Name (CTree i))
@@ -146,10 +177,13 @@
 
 instance Hashable PTerm
 
--- Bounds
+class MonadCddl m where
+  type Phase m :: Type
 
-uintMax :: Integer
-uintMax = 2 ^ (64 :: Int) - 1
+  -- | Look up a top-level rule by name.
+  lookupCddl :: Name -> m (Maybe (CTree (Phase m)))
 
-nintMin :: Integer
-nintMin = -(2 ^ (64 :: Int))
+  -- | Look up the rule bound to a generic parameter at the enclosing rule.
+  -- Returns 'Nothing' outside of a custom generator/validator that was
+  -- attached to a generic rule.
+  lookupGRef :: GRef -> m (Maybe (CTree (Phase m)))

src/Codec/CBOR/Cuddle/CDDL/CTreePhase.hs

@@ -12,9 +12,9 @@ module Codec.CBOR.Cuddle.CDDL.CTreePhase (
 ) where
 
 import Codec.CBOR.Cuddle.CDDL (XCddl, XRule, XTerm, XXTopLevel, XXType2)
-import Codec.CBOR.Cuddle.CDDL.Custom.Core (RuleTerm)
-import Codec.CBOR.Cuddle.CDDL.Custom.Generator (CBORGen)
-import Codec.CBOR.Cuddle.CDDL.Custom.Validator (TermValidator)
+import Codec.CBOR.Cuddle.Core (RuleTerm)
+import Codec.CBOR.Cuddle.Generator.Core (CBORGen)
+import Codec.CBOR.Cuddle.Validator.Core (TermValidator)
 import Data.Default.Class (Default)
 import Data.Hashable (Hashable)
 import GHC.Generics (Generic)