reorganize schema modules

src/Toml.hs

@@ -36,12 +36,17 @@ module Toml (
     encode,
     prettyToml,
     DocClass(..),
+
+    -- * Errors
+    prettyMatchMessage,
+    prettySemanticError
     ) where
 
 import Data.Text (Text)
-import Toml.Pretty (TomlDoc, DocClass(..), prettyToml, prettySemanticError, prettyMatchMessage, prettyLocated)
+import Text.Printf (printf)
+import Toml.Pretty
 import Toml.Schema
-import Toml.Semantics (Value, Value'(..), Table, Table'(..), semantics, forgetTableAnns)
+import Toml.Semantics
 import Toml.Syntax
 
 -- | Parse a TOML formatted 'String' or report an error message.
@@ -71,3 +76,33 @@ decode str =
 -- | Use the 'ToTable' instance to encode a value to a TOML string.
 encode :: ToTable a => a -> TomlDoc
 encode = prettyToml . toTable
+
+-- | Render a TOML decoding error as a human-readable string.
+--
+-- @since 1.3.0.0
+prettyMatchMessage :: MatchMessage Position -> String
+prettyMatchMessage (MatchMessage loc scope msg) = prefix ++ msg ++ " in " ++ path
+    where
+        prefix =
+            case loc of
+                Nothing -> ""
+                Just l -> prettyPosition l ++ ": "
+        path =
+            case scope of
+                [] -> "<top-level>"
+                ScopeKey key : scope' -> shows (prettySimpleKey key) (foldr f "" scope')
+                ScopeIndex i : scope' -> foldr f "" (ScopeIndex i : scope') -- should be impossible
+
+        f (ScopeIndex i) = showChar '[' . shows i . showChar ']'
+        f (ScopeKey key) = showChar '.' . shows (prettySimpleKey key)
+
+-- | Render a semantic TOML error in a human-readable string.
+--
+-- @since 1.3.0.0
+prettySemanticError :: SemanticError Position -> String
+prettySemanticError (SemanticError a key kind) =
+    printf "%s: key error: %s %s" (prettyPosition a) (show (prettySimpleKey key))
+    case kind of
+        AlreadyAssigned -> "is already assigned" :: String
+        ClosedTable     -> "is a closed table"
+        ImplicitlyTable -> "is already implicitly defined to be a table"

src/Toml/Pretty.hs

@@ -33,9 +33,7 @@ module Toml.Pretty (
     prettySimpleKey,
     prettyKey,
 
-    -- * Pretty errors
-    prettySemanticError,
-    prettyMatchMessage,
+    -- * Locations
     prettyLocated,
     prettyPosition,
     ) where
@@ -53,11 +51,9 @@ import Data.Time (ZonedTime(zonedTimeZone), TimeZone (timeZoneMinutes))
 import Data.Time.Format (formatTime, defaultTimeLocale)
 import Prettyprinter
 import Text.Printf (printf)
-import Toml.Schema.FromValue.Matcher (MatchMessage(..), Scope (..))
 import Toml.Semantics
 import Toml.Syntax.Lexer (Token(..))
-import Toml.Syntax.Located (Located(..))
-import Toml.Syntax.Position (Position(..))
+import Toml.Syntax.Position (Located(..), Position(..))
 import Toml.Syntax.Types (SectionKind(..))
 
 -- | Annotation used to enable styling pretty-printed TOML
@@ -339,36 +335,6 @@ prettyToml_ mbKeyProj kind prefix (MkTable t) = vcat (topLines ++ subtables)
             vcat [prettyToml_ mbKeyProj ArrayTableKind key tab | Table' _ tab <- a]
         prettySection _ _ = error "prettySection applied to simple value"
 
--- | Render a semantic TOML error in a human-readable string.
---
--- @since 1.3.0.0
-prettySemanticError :: SemanticError Position -> String
-prettySemanticError (SemanticError a key kind) =
-    printf "%s: key error: %s %s" (prettyPosition a) (show (prettySimpleKey key))
-    case kind of
-        AlreadyAssigned -> "is already assigned" :: String
-        ClosedTable     -> "is a closed table"
-        ImplicitlyTable -> "is already implicitly defined to be a table"
-
--- | Render a TOML decoding error as a human-readable string.
---
--- @since 1.3.0.0
-prettyMatchMessage :: MatchMessage Position -> String
-prettyMatchMessage (MatchMessage loc scope msg) = prefix ++ msg ++ " in " ++ path
-    where
-        prefix =
-            case loc of
-                Nothing -> ""
-                Just l -> prettyPosition l ++ ": "
-        path =
-            case scope of
-                [] -> "<top-level>"
-                ScopeKey key : scope' -> shows (prettySimpleKey key) (foldr f "" scope')
-                ScopeIndex i : scope' -> foldr f "" (ScopeIndex i : scope') -- should be impossible
-
-        f (ScopeIndex i) = showChar '[' . shows i . showChar ']'
-        f (ScopeKey key) = showChar '.' . shows (prettySimpleKey key)
-
 -- |
 -- @since 2.0.0.0
 prettyLocated :: Located String -> String

src/Toml/Schema/FromValue.hs

@@ -75,8 +75,8 @@ import Data.Text.Lazy qualified
 import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay)
 import Data.Word (Word8, Word16, Word32, Word64)
 import Numeric.Natural (Natural)
-import Toml.Schema.FromValue.Matcher
-import Toml.Schema.FromValue.ParseTable
+import Toml.Schema.Matcher
+import Toml.Schema.ParseTable
 import Toml.Semantics
 
 -- | Class for types that can be decoded from a TOML value.

src/Toml/Schema/Generic.hs

@@ -33,20 +33,29 @@ These derived instances would allow you to match TOML @[1,2]@ to value @Coord 1
 
 -}
 module Toml.Schema.Generic (
+    -- * DerivingVia
     GenericTomlTable(GenericTomlTable),
     GenericTomlArray(GenericTomlArray),
+
+    -- * FromValue
     genericFromArray,
     genericFromTable,
+    GFromArray,
+    GToArray,
+
+    -- * ToValue
     genericToArray,
     genericToTable,
+    GToArray,
+    GToTable,
     ) where
 
 import Data.Coerce (coerce)
 import GHC.Generics (Generic(Rep))
 import Toml.Schema.FromValue
-import Toml.Schema.FromValue.Generic
+import Toml.Schema.Generic.FromValue
+import Toml.Schema.Generic.ToValue (GToTable, GToArray, genericToTable, genericToArray)
 import Toml.Schema.ToValue (ToTable(toTable), ToValue(toValue), defaultTableToValue)
-import Toml.Schema.ToValue.Generic (GToTable, GToArray, genericToTable, genericToArray)
 import Toml.Semantics (Value, Value', Table)
 
 -- | Helper type to use GHC's DerivingVia extension to derive

src/Toml/Schema/FromValue/Generic.hs → src/Toml/Schema/Generic/FromValue.hs

@@ -1,6 +1,6 @@
 {-# Language DataKinds, InstanceSigs, ScopedTypeVariables, TypeOperators #-}
 {-|
-Module      : Toml.Schema.FromValue.Generic
+Module      : Toml.Schema.Generic.FromValue
 Description : GHC.Generics derived table parsing
 Copyright   : (c) Eric Mertens, 2023
 License     : ISC
@@ -11,7 +11,7 @@ of a record. This can be combined with 'Toml.FromValue.parseTableFromValue'
 to derive a 'Toml.FromValue.FromValue' instance.
 
 -}
-module Toml.Schema.FromValue.Generic (
+module Toml.Schema.Generic.FromValue (
     -- * Record from table
     GParseTable(..),
     genericParseTable,
@@ -27,9 +27,9 @@ import Data.Coerce (coerce)
 import Data.Text qualified as Text
 import GHC.Generics
 import Toml.Schema.FromValue (FromValue, fromValue, optKey, reqKey, parseTableFromValue)
-import Toml.Schema.FromValue.Matcher (Matcher, failAt)
-import Toml.Schema.FromValue.ParseTable (ParseTable)
-import Toml.Semantics
+import Toml.Schema.Matcher (Matcher, failAt)
+import Toml.Schema.ParseTable (ParseTable)
+import Toml.Semantics (valueAnn, valueType, Value'(List'))
 
 -- | Match a 'Table' using the field names in a record.
 --

src/Toml/Schema/ToValue/Generic.hs → src/Toml/Schema/Generic/ToValue.hs

@@ -1,5 +1,5 @@
 {-|
-Module      : Toml.Schema.ToValue.Generic
+Module      : Toml.Schema.Generic.ToValue
 Description : GHC.Generics derived table generation
 Copyright   : (c) Eric Mertens, 2023
 License     : ISC
@@ -12,7 +12,7 @@ Use 'genericToArray' to derive an instance of 'Toml.ToValue.ToValue'
 using the positions of data in a constructor.
 
 -}
-module Toml.Schema.ToValue.Generic (
+module Toml.Schema.Generic.ToValue (
 
     -- * Records to Tables
     GToTable(..),

src/Toml/Schema/FromValue/Matcher.hs → src/Toml/Schema/Matcher.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-|
-Module      : Toml.Schema.FromValue.Matcher
+Module      : Toml.Schema.Matcher
 Description : A type for building results while tracking scopes
 Copyright   : (c) Eric Mertens, 2023
 License     : ISC
@@ -19,7 +19,7 @@ Use 'Toml.Pretty.prettyMatchMessage' for an easy way to make human
 readable strings from matcher outputs.
 
 -}
-module Toml.Schema.FromValue.Matcher (
+module Toml.Schema.Matcher (
     -- * Types
     Matcher,
     Result(..),

src/Toml/Schema/FromValue/ParseTable.hs → src/Toml/Schema/ParseTable.hs

@@ -1,5 +1,5 @@
 {-|
-Module      : Toml.FromValue.ParseTable
+Module      : Toml.Schema.ParseTable
 Description : A type for matching keys out of a table
 Copyright   : (c) Eric Mertens, 2023
 License     : ISC
@@ -17,7 +17,7 @@ most of the basic functionality is exported directly from
 "Toml.FromValue".
 
 -}
-module Toml.Schema.FromValue.ParseTable (
+module Toml.Schema.ParseTable (
     -- * Base interface
     ParseTable,
     KeyAlt(..),
@@ -42,9 +42,9 @@ import Data.Foldable (for_)
 import Data.List (intercalate)
 import Data.Map qualified as Map
 import Data.Text (Text)
-import Toml.Pretty (prettySimpleKey)
-import Toml.Schema.FromValue.Matcher (Matcher, inKey, failAt, warn, warnAt)
+import Toml.Schema.Matcher (Matcher, inKey, failAt, warn, warnAt)
 import Toml.Semantics (Table'(..), Value')
+import Toml.Pretty
 
 -- | Parser that tracks a current set of unmatched key-value
 -- pairs from a table.
@@ -75,7 +75,6 @@ parseTable (ParseTable p) l t =
         warnAt a ("unexpected key: " ++ show (prettySimpleKey k))
     pure x
 
-
 -- | Return the remaining portion of the table being matched.
 getTable :: ParseTable l (Table' l)
 getTable = ParseTable (lift get)

src/Toml/Syntax.hs

@@ -31,6 +31,5 @@ module Toml.Syntax (
 ) where
 
 import Toml.Syntax.Lexer
-import Toml.Syntax.Located
 import Toml.Syntax.Parser
 import Toml.Syntax.Position

src/Toml/Syntax/Lexer.x

@@ -23,7 +23,6 @@ import Data.Text (Text)
 import Data.Text qualified as Text
 import Toml.Syntax.Token
 import Toml.Syntax.LexerUtils
-import Toml.Syntax.Located
 import Toml.Syntax.Position
 
 }

src/Toml/Syntax/LexerUtils.hs

@@ -54,8 +54,7 @@ import Data.Time.Format (parseTimeM, defaultTimeLocale, ParseTime)
 import Numeric (readHex)
 import Text.Printf (printf)
 import Toml.Syntax.Token (Token(..))
-import Toml.Syntax.Located (Located(..))
-import Toml.Syntax.Position (move, Position)
+import Toml.Syntax.Position (move, Located(..), Position)
 
 -- | Type of actions associated with lexer patterns
 type Action = Located Text -> Context -> Outcome

src/Toml/Syntax/Parser.y

@@ -25,9 +25,8 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Text (Text)
 import Toml.Syntax.Lexer (Context(..), Token(..))
-import Toml.Syntax.Located (Located(Located, locThing))
 import Toml.Syntax.ParserUtils
-import Toml.Syntax.Position (Position)
+import Toml.Syntax.Position (Located(Located, locThing), Position)
 import Toml.Syntax.Position (startPos)
 import Toml.Syntax.Types (Expr(..), Key, Val(..), SectionKind(..))
 

src/Toml/Syntax/ParserUtils.hs

@@ -41,8 +41,7 @@ import Data.Text (Text)
 import Data.Time
 import Toml.Pretty (prettyToken)
 import Toml.Syntax.Lexer (scanToken, Context(..))
-import Toml.Syntax.Located (Located(..))
-import Toml.Syntax.Position (Position)
+import Toml.Syntax.Position (Located(..), Position)
 import Toml.Syntax.Token (Token(..))
 
 -- continuation passing implementation of a state monad with errors

src/Toml/Syntax/Position.hs

@@ -13,12 +13,23 @@ This module assumes 8 column wide tab stops.
 
 -}
 module Toml.Syntax.Position (
+    Located(..),
     Position(..),
     startPos,
     move,
     ) where
 
-import Data.Data ( Data )
+-- | A value annotated with its text file position
+data Located a = Located
+    { locPosition :: {-# UNPACK #-} !Position -- ^ position
+    , locThing    :: !a -- ^ thing at position
+    }
+    deriving (
+        Read        {- ^ Default instance -},
+        Show        {- ^ Default instance -},
+        Functor     {- ^ Default instance -},
+        Foldable    {- ^ Default instance -},
+        Traversable {- ^ Default instance -})
 
 -- | A position in a text file
 data Position = Position {
@@ -29,8 +40,7 @@ data Position = Position {
         Read    {- ^ Default instance -},
         Show    {- ^ Default instance -},
         Ord     {- ^ Default instance -},
-        Eq      {- ^ Default instance -},
-        Data    {- ^ Default instance -})
+        Eq      {- ^ Default instance -})
 
 -- | The initial 'Position' for the start of a file
 startPos :: Position

test-drivers/encoder/Main.hs

@@ -23,7 +23,7 @@ import Data.Text qualified as Text
 import System.Exit (exitFailure)
 import Toml (prettyToml, Value(..), Value'(..), Table)
 import Toml.Syntax.Lexer (lexValue, Token(..))
-import Toml.ToValue (toValue)
+import Toml.Schema (toValue)
 
 main :: IO ()
 main =

test-drivers/highlighter/Main.hs

@@ -12,8 +12,9 @@ module Main (main) where
 
 import Data.Text.IO qualified as Text
 import Prettyprinter.Render.Terminal
-import Toml.Parser (parseRawToml)
-import Toml.Pretty (prettyTomlOrdered, DocClass(..), prettyLocated, prettySemanticError)
+import Toml
+import Toml.Pretty (prettyLocated, prettyTomlOrdered)
+import Toml.Syntax (parseRawToml)
 import Toml.Semantics (semantics)
 import Toml.Semantics.Ordered (extractTableOrder, projectKey)
 

test/FromValueSpec.hs

@@ -14,7 +14,6 @@ import Control.Monad (when)
 import Test.Hspec (it, shouldBe, Spec)
 import Toml
 import Toml.Schema
-import Toml.Pretty (prettyMatchMessage)
 import Toml.Syntax (startPos)
 
 humanMatcher :: Matcher l a -> Result String a