Quality of Life improvments (#15)

Update Drone.yaml signature

Remove ghc8.4.4 compatibility for now :(

Even more Safe instances

More pretty instances

Add much needed pretty-printing instances

Fix hie.yaml for VSCode

Fix up lsp

Clean up warnings

Add -XTrustworthy and -XSafe all over the place

Co-authored-by: Alex Feldman-Crough <alex@fldcr.com>
Reviewed-on: #15

.drone.yml

@@ -32,10 +32,6 @@ steps:
   name: ghc 8.6.5
   image: utdemir/ghc-musl:v4-integer-simple-ghc865
 
-- <<: *default-steps
-  name: ghc 8.4.4
-  image: utdemir/ghc-musl:v4-libgmp-ghc844
-
 - name: docs
   image: utdemir/ghc-musl:v4-integer-simple-ghc881
   depends_on: 
@@ -74,6 +70,6 @@ volumes:
       path: /var/cache/cabal
 ---
 kind: signature
-hmac: 4182c9a06e0671846733a1cd1617ad52119e1a96be312770004503c6be80b553
+hmac: 43d513b190eab1ed25a0877d256149f29fff80a26dafa0c3cd938c2dde711f2c
 
 ...

.vscode/settings.json

@@ -13,5 +13,6 @@
         "**/.env/**": true,
         "**/dist/**": true,
         "**/dist-newstyle/**": true
-    }
+    },
+    "hic.arguments": "--lsp --cwd src"
 }

prosidy.cabal

@@ -13,9 +13,9 @@ data-files:          golden/**/*.pro, golden/**/*.json
 extra-source-files:  CHANGELOG.md, README.pro
 
 tested-with:
-    GHC == 8.4.4
-  , GHC == 8.6.5
+    GHC == 8.6.5
   , GHC == 8.8.1
+  , GHC == 8.8.3
 
 description:
     Prosidy is a small language for writing documents.
@@ -58,6 +58,10 @@ library
 
     other-modules:
         Prosidy.Optics.Internal
+      , Prosidy.Source.LineMap
+      , Prosidy.Source.Units
+      , Prosidy.Internal.Classes
+      , Prosidy.Internal.JSON
 
     build-depends:
         base                  >= 4.11 && < 5
@@ -69,6 +73,7 @@ library
       , deepseq               >= 1.4  && < 1.5
       , hashable              >= 1.2  && < 1.4
       , megaparsec            >= 7.0  && < 8.1
+      , prettyprinter         >= 1.6  && < 1.7
       , profunctors           >= 5.3  && < 5.6
       , tagged                >= 0.8  && < 0.9
       , text                  >= 1.2  && < 1.3

scripts/format

@@ -43,7 +43,7 @@ grep \
     --files-without-match \
     --include '*.hs' \
     --recursive \
-    '\{-#\s+ANN\s+module\s+"nofmt"\s+#-}' \
+    --regexp='{-# +LANGUAGE +ViewPatterns +#-}' \
     src/ test/ \
 | xargs -t brittany --config-file brittany.yaml --write-mode inplace
 num_changed="$(git ls-files --exclude-standard --modified | tee /dev/tty | wc -l)"

src/Prosidy.hs

@@ -5,6 +5,7 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
+{-# LANGUAGE Safe #-}
 module Prosidy (module X) where
 
 import           Prosidy.Source                as X
@@ -17,3 +18,5 @@ import           Prosidy.Source                as X
 import           Prosidy.Optics                as X
 import           Prosidy.Parse                 as X
 import           Prosidy.Types                 as X
+
+import           Prosidy.Internal.JSON          ( )

src/Prosidy/Internal/Classes.hs

@@ -0,0 +1,26 @@
+{- |
+Module      : Prosidy.Internal.Classes
+Description : An internal module exporting common classes.
+Copyright   : (c) James Alexander Feldman-Crough, 2019
+License     : MPL-2.0
+Maintainer  : alex@fldcr.com
+-}
+{-# LANGUAGE Trustworthy #-}
+module Prosidy.Internal.Classes (module X) where
+
+import           Data.Aeson                    as X
+                                                ( ToJSON(..)
+                                                , FromJSON(..)
+                                                , ToJSONKey(..)
+                                                , FromJSONKey(..)
+                                                )
+import           Data.Binary                   as X
+                                                ( Binary(..) )
+import           GHC.Generics                  as X
+                                                ( Generic )
+import           Control.DeepSeq               as X
+                                                ( NFData(..) )
+import           Data.Hashable                 as X
+                                                ( Hashable(..) )
+import           Data.Text.Prettyprint.Doc     as X
+                                                ( Pretty(..) )

src/Prosidy/Internal/JSON.hs

@@ -0,0 +1,154 @@
+{- |
+Module      : Prosidy.Internal.JSON
+Description : Orphan JSON instances to let as many modules be -XSafe as possible.
+Copyright   : (c) James Alexander Feldman-Crough, 2019
+License     : MPL-2.0
+Maintainer  : alex@fldcr.com
+-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Trustworthy #-}
+module Prosidy.Internal.JSON () where
+
+import           Prosidy.Internal.Classes
+import           Prosidy.Types
+import           Data.Aeson
+import qualified Data.HashMap.Strict           as HM
+import           Data.Text                      ( Text )
+import           Control.Exception              ( displayException )
+
+instance FromJSON Block where
+    parseJSON = withObject "block" $ \o -> do
+        ty <- o .: "type"
+        case ty :: Text of
+            "tag" -> do
+                subtype <- o .: "subtype"
+                case subtype :: Text of
+                    "block"   -> BlockTag <$> o .: "value"
+                    "literal" -> BlockLiteral <$> o .: "value"
+                    _         -> fail $ "unknown tag subtype: " <> show subtype
+            "paragraph" -> BlockParagraph <$> o .: "value"
+            _           -> fail $ "unknown block type: " <> show ty
+
+instance ToJSON Block where
+    toEncoding b = pairs . mconcat $ case b of
+        BlockLiteral t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("literal" :: Text)
+            , "value" .= t
+            ]
+        BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]
+        BlockTag t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("block" :: Text)
+            , "value" .= t
+            ]
+
+    toJSON b = object $ case b of
+        BlockLiteral t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("literal" :: Text)
+            , "value" .= t
+            ]
+        BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]
+        BlockTag t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("block" :: Text)
+            , "value" .= t
+            ]
+
+instance FromJSON Document where
+    parseJSON = withObject "Document"
+        $ \o -> Document <$> o .: "metadata" <*> o .: "content"
+
+instance ToJSON Document where
+    toEncoding (Document md ct) =
+        pairs $ mconcat ["metadata" .= md, "content" .= ct]
+
+    toJSON (Document md ct) = object ["metadata" .= md, "content" .= ct]
+
+instance FromJSON Fragment where
+    parseJSON = withText "Fragment" $ pure . flip Fragment Nothing
+
+instance ToJSON Fragment where
+    toEncoding = toEncoding . fragmentText
+    toJSON     = toJSON . fragmentText
+
+instance FromJSON Inline where
+    parseJSON = withObject "Inline" $ \o -> do
+        ty <- o .: "type"
+        case ty :: Text of
+            "break" -> pure Break
+            "tag"   -> InlineTag <$> o .: "value"
+            "text"  -> InlineText <$> o .: "value"
+            _       -> fail $ "unknown inline type: " <> show ty
+
+instance ToJSON Inline where
+    toEncoding i = pairs . mconcat $ case i of
+        Break -> ["type" .= ("break" :: Text), "value" .= Null]
+        InlineTag t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("inline" :: Text)
+            , "value" .= t
+            ]
+        InlineText t -> ["type" .= ("text" :: Text), "value" .= t]
+
+    toJSON i = object $ case i of
+        Break -> ["type" .= ("break" :: Text)]
+        InlineTag t ->
+            [ "type" .= ("tag" :: Text)
+            , "subtype" .= ("inline" :: Text)
+            , "value" .= t
+            ]
+        InlineText t -> ["type" .= ("text" :: Text), "value" .= t]
+
+instance FromJSON Metadata where
+    parseJSON = withObject "Metadata"
+        $ \o -> Metadata <$> o .: "properties" <*> o .: "settings"
+
+instance ToJSON Metadata where
+    toEncoding (Metadata ps ss) =
+        pairs $ mconcat ["properties" .= ps, "settings" .= ss]
+
+    toJSON (Metadata ps ss) = object ["properties" .= ps, "settings" .= ss]
+
+instance FromJSON Paragraph where
+    parseJSON = fmap (flip Paragraph Nothing) . parseJSON
+
+instance ToJSON Paragraph where
+    toEncoding (Paragraph s _) = toEncoding s
+    toJSON (Paragraph s _) = toJSON s
+
+instance ToJSON a => ToJSON (Region a) where
+    toJSON (Region md ct _) = object ["metadata" .= md, "content" .= ct]
+
+instance FromJSON a => FromJSON (Tag a) where
+    parseJSON = withObject "Tag" $ \o ->
+        Tag
+            <$> o
+            .:  "name"
+            <*> o
+            .:  "metadata"
+            <*> o
+            .:  "content"
+            <*> pure Nothing
+
+instance ToJSON a => ToJSON (Tag a) where
+    toEncoding (Tag nm md ct _) =
+        pairs $ mconcat ["name" .= nm, "metadata" .= md, "content" .= ct]
+
+    toJSON (Tag nm md ct _) =
+        object ["name" .= nm, "metadata" .= md, "content" .= ct]
+
+instance FromJSONKey Key where
+    fromJSONKey =
+        FromJSONKeyTextParser $ either (fail . displayException) pure . makeKey
+
+instance (Hashable a, Eq a, ToJSONKey a) => ToJSON (Set a) where
+    toJSON (Set hs) = toJSON $ foldMap (flip HM.singleton True) hs
+    toEncoding (Set hs) = toEncoding $ foldMap (flip HM.singleton True) hs
+
+instance (Hashable a, Eq a, FromJSONKey a) => FromJSON (Set a) where
+    parseJSON json = do
+        m <- parseJSON json
+        pure . Set . HM.keysSet $ HM.filter id m

src/Prosidy/Optics.hs

@@ -5,6 +5,7 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
+{-# LANGUAGE Safe #-}
 module Prosidy.Optics (module X) where
 
 import           Prosidy.Optics.Source         as X

src/Prosidy/Optics/Internal.hs

@@ -7,6 +7,7 @@ Maintainer  : alex@fldcr.com
 -}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Optics.Internal
     ( module Prosidy.Optics.Internal
     , Profunctor(..)

src/Prosidy/Optics/Source.hs

@@ -5,6 +5,7 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
+{-# LANGUAGE Safe #-}
 module Prosidy.Optics.Source
     ( -- * Classy optics; implementable on all types with a location
       HasLocation(..)

src/Prosidy/Optics/Types.hs

@@ -8,6 +8,7 @@ Maintainer  : alex@fldcr.com
 {-# LANGUAGE LambdaCase   #-}
 {-# LANGUAGE RankNTypes   #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Optics.Types
     ( -- * Classy optics
       -- ** Items with 'Metadata' 

src/Prosidy/Parse.hs

@@ -5,6 +5,7 @@ Copyright   : (c) James Alexander Feldman-Crough, 2019
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
+{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE ApplicativeDo     #-}

src/Prosidy/Source.hs

@@ -5,15 +5,12 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Source
     ( Source(..)
     , Location
@@ -37,24 +34,15 @@ module Prosidy.Source
     )
 where
 
-import           Data.Hashable                  ( Hashable(..) )
-import           Data.Vector.Unboxed            ( Vector
-                                                , MVector
-                                                , Unbox
-                                                )
 import           Data.Text                      ( Text )
-import           GHC.Generics                   ( Generic )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary(..) )
-import           Data.Aeson                     ( ToJSON(..)
-                                                , FromJSON(..)
-                                                )
 import           Control.Monad                  ( guard )
 
 import qualified Data.Text                     as T
-import qualified Data.Vector.Unboxed           as V
-import qualified Data.Vector.Generic           as VG
-import qualified Data.Vector.Generic.Mutable   as VGM
+import qualified Data.Text.Prettyprint.Doc     as PP
+
+import           Prosidy.Internal.Classes
+import           Prosidy.Source.LineMap
+import           Prosidy.Source.Units
 
 -- | Information about Prosidy source file.
 --
@@ -79,6 +67,9 @@ data Source = Source
 instance Show Source where
     show (Source fp _ _) = "Source " <> show fp
 
+instance Pretty Source where
+    pretty = pretty . sourceName
+
 -- | Create a 'Source' from a descriptive name and a body. The source name is
 -- typically a 'FilePath', but this is not guarenteed. For instance, when read 
 -- from standard-input, Prosidy chooses to name the source @\<stdin\>@.
@@ -86,7 +77,7 @@ makeSource :: String -> Text -> Source
 makeSource name body = Source name body lineMap
   where
     lineMap = case T.foldl' lineMapFold (1, '\0', []) $ body of
-        (_, _, acc) -> LineMap . V.fromList . reverse $ acc
+        (_, _, acc) -> fromOffsets acc
     lineMapFold (ix, prev, acc) ch
         | ch == '\n' && prev == '\r' = (succ ix, ch, Offset ix : drop 1 acc)
         | ch == '\n' || ch == '\r'   = (succ ix, ch, Offset ix : acc)
@@ -132,6 +123,10 @@ data Location = Location
   deriving stock (Show, Generic, Eq)
   deriving anyclass (NFData, Binary, Hashable)
 
+instance Pretty Location where
+    pretty loc = pretty (locationSource loc) PP.<+> "@" PP.<+> mconcat
+        [pretty (locationLine loc), "×", pretty (locationColumn loc)]
+
 -- | Add lazily computed line and column number information to a 
 -- 'SparseLocation'.
 enrichLocation :: SparseLocation -> Location
@@ -154,115 +149,3 @@ stripLocation :: Location -> SparseLocation
 stripLocation l = SparseLocation { sparseLocationSource = locationSource l
                                  , sparseLocationOffset = locationOffset l
                                  }
-
--- | A dense vector containing offsets poiting to the start of each line. That
--- is, the starting position of the third line of a file can be found at
--- position 2.
-newtype LineMap = LineMap (Vector Offset)
-  deriving stock (Eq, Generic)
-  deriving newtype (Show, NFData)
-
-instance Binary LineMap where
-    get = fmap (LineMap . V.fromList) get
-    put (LineMap v) = put (V.toList v)
-
-instance Hashable LineMap where
-    hashWithSalt salt (LineMap v) = V.foldl' hashWithSalt salt v
-
--- | Convert a 'LineMap' into a list of 'Offset's, corresponding to the first
--- character of a line. Note that the initial offset is omitted-- the offset at
--- index 0 will be the offset of the /second/ line.
-lineOffsets :: LineMap -> [Offset]
-lineOffsets (LineMap v) = V.toList v
-
--- | Fetch the 'Offset' for the given 'Line'. Evaluates to 'Nothing' if the
--- given 'Line' does not appear in the LineMap
-lineToOffset :: Line -> LineMap -> Maybe Offset
-lineToOffset (Line 0  ) _            = Just $ Offset 0
-lineToOffset (Line nth) (LineMap xs) = xs V.!? fromIntegral (pred nth)
-
--- | Fetch the 'Line' number for a given 'Offset'. Newlines will be attributed
--- the line that they terminate, rather than the line started immediately 
--- afterwards.
-offsetToLine :: Offset -> LineMap -> Line
-offsetToLine offset (LineMap xs) = Line . fromIntegral $ go Nothing
-                                                            0
-                                                            (V.length xs)
-  where
-    go result min max
-        | min >= max
-        = maybe 0 succ result
-        | otherwise
-        = let nthIndex  = ((max - min) `div` 2) + min
-              nthOffset = xs V.! nthIndex
-          in  case nthOffset `compare` offset of
-                  EQ -> succ nthIndex
-                  LT -> go (Just nthIndex) (nthIndex + 1) max
-                  GT -> go result min nthIndex
-
--- | A line number.
---
--- The 'Show' instance for 'Line' counts from one, while the internal
--- implementation counts from zero.
-newtype Line = Line Word
-  deriving stock (Eq, Ord, Generic, Show)
-  deriving newtype (ToJSON, FromJSON, Enum)
-  deriving anyclass (Hashable, NFData, Binary)
-
--- | A column number.
-newtype Column = Column Word
-  deriving stock (Eq, Ord, Generic, Show)
-  deriving newtype (ToJSON, FromJSON, Enum)
-  deriving anyclass (Hashable, NFData, Binary)
-
--- | An offset into a 'Source', counted by UTF-8 codepoint.
-newtype Offset = Offset Word
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving newtype (ToJSON, FromJSON, Enum)
-  deriving anyclass (Hashable, NFData, Binary)
-
-newtype instance MVector s Offset = MV_Offset (MVector s Word)
-
-instance VGM.MVector MVector Offset where
-    basicLength (MV_Offset m) = VGM.basicLength m
-    {-# INLINE basicLength #-}
-
-    basicUnsafeSlice ix len (MV_Offset m) =
-        MV_Offset $ VGM.basicUnsafeSlice ix len m
-    {-# INLINE basicUnsafeSlice #-}
-
-    basicOverlaps (MV_Offset x) (MV_Offset y) = VGM.basicOverlaps x y
-    {-# INLINE basicOverlaps #-}
-
-    basicUnsafeNew len = MV_Offset <$> VGM.basicUnsafeNew len
-    {-# INLINE basicUnsafeNew #-}
-
-    basicInitialize (MV_Offset v) = VGM.basicInitialize v
-    {-# INLINE basicInitialize #-}
-
-    basicUnsafeRead (MV_Offset v) = fmap Offset <$> VGM.basicUnsafeRead v
-    {-# INLINE basicUnsafeRead #-}
-
-    basicUnsafeWrite (MV_Offset v) ix (Offset w) = VGM.basicUnsafeWrite v ix w
-    {-# INLINE basicUnsafeWrite #-}
-
-newtype instance Vector Offset = V_Offset (Vector Word)
-
-instance VG.Vector Vector Offset where
-    basicUnsafeFreeze (MV_Offset v) = V_Offset <$> VG.basicUnsafeFreeze v
-    {-# INLINE basicUnsafeFreeze #-}
-
-    basicUnsafeThaw (V_Offset v) = MV_Offset <$> VG.basicUnsafeThaw v
-    {-# INLINE basicUnsafeThaw #-}
-
-    basicLength (V_Offset v) = VG.basicLength v
-    {-# INLINE basicLength #-}
-
-    basicUnsafeSlice ix len (V_Offset v) =
-        V_Offset $ VG.basicUnsafeSlice ix len v
-    {-# INLINE basicUnsafeSlice #-}
-
-    basicUnsafeIndexM (V_Offset v) ix = Offset <$> VG.basicUnsafeIndexM v ix
-    {-# INLINE basicUnsafeIndexM #-}
-
-instance Unbox Offset where

src/Prosidy/Source/LineMap.hs

@@ -0,0 +1,130 @@
+{- |
+Module      : Prosidy.Source.LineMap
+Description : Binary-search tree for finding the position of new lines.
+Copyright   : (c) James Alexander Feldman-Crough, 2019
+License     : MPL-2.0
+Maintainer  : alex@fldcr.com
+-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Trustworthy #-}
+module Prosidy.Source.LineMap
+    ( LineMap
+    , lineOffsets
+    , lineToOffset
+    , offsetToLine
+    , fromOffsets
+    )
+where
+
+import qualified Data.Vector.Unboxed           as V
+import qualified Data.Vector.Generic           as VG
+import qualified Data.Vector.Generic.Mutable   as VGM
+import           Data.Vector.Unboxed            ( Vector
+                                                , MVector
+                                                , Unbox
+                                                )
+
+import           Data.Foldable
+import           Data.List                      ( sort )
+
+import           Prosidy.Internal.Classes
+import           Prosidy.Source.Units
+
+-- | A dense vector containing offsets poiting to the start of each line. That
+-- is, the starting position of the third line of a file can be found at
+-- position 2.
+newtype LineMap = LineMap (Vector Offset)
+  deriving stock (Eq, Generic)
+  deriving newtype (Show, NFData)
+
+instance Binary LineMap where
+    get = fmap (LineMap . V.fromList) get
+    put (LineMap v) = put (V.toList v)
+
+instance Hashable LineMap where
+    hashWithSalt salt (LineMap v) = V.foldl' hashWithSalt salt v
+
+fromOffsets :: Foldable f => f Offset -> LineMap
+fromOffsets = LineMap . V.fromList . sort . toList
+
+-- | Convert a 'LineMap' into a list of 'Offset's, corresponding to the first
+-- character of a line. Note that the initial offset is omitted-- the offset at
+-- index 0 will be the offset of the /second/ line.
+lineOffsets :: LineMap -> [Offset]
+lineOffsets (LineMap v) = V.toList v
+
+-- | Fetch the 'Offset' for the given 'Line'. Evaluates to 'Nothing' if the
+-- given 'Line' does not appear in the LineMap
+lineToOffset :: Line -> LineMap -> Maybe Offset
+lineToOffset (Line 0  ) _            = Just $ Offset 0
+lineToOffset (Line nth) (LineMap xs) = xs V.!? fromIntegral (pred nth)
+
+-- | Fetch the 'Line' number for a given 'Offset'. Newlines will be attributed
+-- the line that they terminate, rather than the line started immediately 
+-- afterwards.
+offsetToLine :: Offset -> LineMap -> Line
+offsetToLine offset (LineMap xs) = Line . fromIntegral $ go Nothing
+                                                            0
+                                                            (V.length xs)
+  where
+    go result min max
+        | min >= max
+        = maybe 0 succ result
+        | otherwise
+        = let nthIndex  = ((max - min) `div` 2) + min
+              nthOffset = xs V.! nthIndex
+          in  case nthOffset `compare` offset of
+                  EQ -> succ nthIndex
+                  LT -> go (Just nthIndex) (nthIndex + 1) max
+                  GT -> go result min nthIndex
+
+newtype instance MVector s Offset = MV_Offset (MVector s Word)
+
+instance VGM.MVector MVector Offset where
+    basicLength (MV_Offset m) = VGM.basicLength m
+    {-# INLINE basicLength #-}
+
+    basicUnsafeSlice ix len (MV_Offset m) =
+        MV_Offset $ VGM.basicUnsafeSlice ix len m
+    {-# INLINE basicUnsafeSlice #-}
+
+    basicOverlaps (MV_Offset x) (MV_Offset y) = VGM.basicOverlaps x y
+    {-# INLINE basicOverlaps #-}
+
+    basicUnsafeNew len = MV_Offset <$> VGM.basicUnsafeNew len
+    {-# INLINE basicUnsafeNew #-}
+
+    basicInitialize (MV_Offset v) = VGM.basicInitialize v
+    {-# INLINE basicInitialize #-}
+
+    basicUnsafeRead (MV_Offset v) = fmap Offset <$> VGM.basicUnsafeRead v
+    {-# INLINE basicUnsafeRead #-}
+
+    basicUnsafeWrite (MV_Offset v) ix (Offset w) = VGM.basicUnsafeWrite v ix w
+    {-# INLINE basicUnsafeWrite #-}
+
+newtype instance Vector Offset = V_Offset (Vector Word)
+
+instance VG.Vector Vector Offset where
+    basicUnsafeFreeze (MV_Offset v) = V_Offset <$> VG.basicUnsafeFreeze v
+    {-# INLINE basicUnsafeFreeze #-}
+
+    basicUnsafeThaw (V_Offset v) = MV_Offset <$> VG.basicUnsafeThaw v
+    {-# INLINE basicUnsafeThaw #-}
+
+    basicLength (V_Offset v) = VG.basicLength v
+    {-# INLINE basicLength #-}
+
+    basicUnsafeSlice ix len (V_Offset v) =
+        V_Offset $ VG.basicUnsafeSlice ix len v
+    {-# INLINE basicUnsafeSlice #-}
+
+    basicUnsafeIndexM (V_Offset v) ix = Offset <$> VG.basicUnsafeIndexM v ix
+    {-# INLINE basicUnsafeIndexM #-}
+
+instance Unbox Offset where

src/Prosidy/Source/Units.hs

@@ -0,0 +1,46 @@
+{- |
+Module      : Prosidy.Source.Units
+Description : Positional units for marking source-code locations.
+Copyright   : (c) James Alexander Feldman-Crough, 2019
+License     : MPL-2.0
+Maintainer  : alex@fldcr.com
+-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Safe #-}
+module Prosidy.Source.Units (Line(..), Column(..), Offset(..)) where
+
+import           Prosidy.Internal.Classes
+
+-- | A line number.
+--
+-- The 'Show' instance for 'Line' counts from one, while the internal
+-- implementation counts from zero.
+newtype Line = Line Word
+  deriving stock (Eq, Ord, Generic, Show)
+  deriving anyclass (Hashable, NFData, Binary)
+  deriving (ToJSON, FromJSON, Enum) via Word
+
+instance Pretty Line where
+    pretty (Line n) = pretty $ succ n
+
+-- | A column number.
+newtype Column = Column Word
+  deriving stock (Eq, Ord, Generic, Show)
+  deriving anyclass (Hashable, NFData, Binary)
+  deriving (ToJSON, FromJSON, Enum) via Word
+
+instance Pretty Column where
+    pretty (Column n) = pretty $ succ n
+
+-- | An offset into a 'Source', counted by UTF-8 codepoint.
+newtype Offset = Offset Word
+  deriving stock (Eq, Show, Ord, Generic)
+  deriving anyclass (Hashable, NFData, Binary)
+  deriving (ToJSON, FromJSON, Enum) via Word
+
+instance Pretty Offset where
+    pretty (Offset n) = "+" <> pretty n

src/Prosidy/Types.hs

@@ -5,15 +5,16 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TypeApplications #-}
@@ -49,6 +50,8 @@ module Prosidy.Types
     )
 where
 
+import           Prosidy.Internal.Classes
+
 import           Prosidy.Types.Assoc           as X
                                                 ( Assoc(..) )
 import           Prosidy.Types.Key             as X
@@ -67,21 +70,10 @@ import           Prosidy.Types.Set             as X
 import           Prosidy.Source                 ( Location )
 
 import           Data.Text                      ( Text )
-import           GHC.Generics                   ( Generic )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary )
-import           Data.Hashable                  ( Hashable )
-import           Data.Aeson                     ( ToJSON(..)
-                                                , FromJSON(..)
-                                                , withObject
-                                                , withText
-                                                , (.:)
-                                                , (.=)
-                                                , object
-                                                , pairs
-                                                )
-
-import qualified Data.Aeson                    as Aeson
+import           Data.Text.Prettyprint.Doc      ( (<+>) )
+import           Data.Foldable                  ( toList )
+import           Prosidy.Types.Assoc            ( toEntries )
+import qualified Data.Text.Prettyprint.Doc     as PP
 
 -------------------------------------------------------------------------------
 -- | A sum type enumerating allowed types inside of a block context.
@@ -92,45 +84,10 @@ data Block =
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable, Binary, NFData)
 
-instance FromJSON Block where
-    parseJSON = withObject "block" $ \o -> do
-        ty <- o .: "type"
-        case ty :: Text of
-            "tag" -> do
-                subtype <- o .: "subtype"
-                case subtype :: Text of
-                    "block"   -> BlockTag <$> o .: "value"
-                    "literal" -> BlockLiteral <$> o .: "value"
-                    _         -> fail $ "unknown tag subtype: " <> show subtype
-            "paragraph" -> BlockParagraph <$> o .: "value"
-            _           -> fail $ "unknown block type: " <> show ty
-
-instance ToJSON Block where
-    toEncoding b = pairs . mconcat $ case b of
-        BlockLiteral t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("literal" :: Text)
-            , "value" .= t
-            ]
-        BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]
-        BlockTag t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("block" :: Text)
-            , "value" .= t
-            ]
-
-    toJSON b = object $ case b of
-        BlockLiteral t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("literal" :: Text)
-            , "value" .= t
-            ]
-        BlockParagraph p -> ["type" .= ("paragraph" :: Text), "value" .= p]
-        BlockTag t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("block" :: Text)
-            , "value" .= t
-            ]
+instance Pretty Block where
+    pretty (BlockLiteral   lit) = pretty lit
+    pretty (BlockParagraph pp ) = pretty pp
+    pretty (BlockTag       tag) = pretty tag
 
 -------------------------------------------------------------------------------
 -- | A full Prosidy document.
@@ -141,15 +98,8 @@ data Document = Document
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable, NFData, Binary)
 
-instance FromJSON Document where
-    parseJSON = withObject "Document"
-        $ \o -> Document <$> o .: "metadata" <*> o .: "content"
-
-instance ToJSON Document where
-    toEncoding (Document md ct) =
-        pairs $ mconcat ["metadata" .= md, "content" .= ct]
-
-    toJSON (Document md ct) = object ["metadata" .= md, "content" .= ct]
+instance Pretty Document where
+    pretty (Document md ct) = PP.nest 4 . PP.vsep $ [pretty md, pretty ct]
 
 -- | Convert a 'Document' to a 'Region'. The resulting 'Region' will never have
 -- a 'Location' attached. 
@@ -172,12 +122,8 @@ data Fragment = Fragment
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable, Binary, NFData)
 
-instance FromJSON Fragment where
-    parseJSON = withText "Fragment" $ pure . flip Fragment Nothing
-
-instance ToJSON Fragment where
-    toEncoding = toEncoding . fragmentText
-    toJSON     = toJSON . fragmentText
+instance Pretty Fragment where
+    pretty = pretty . fragmentText
 
 -------------------------------------------------------------------------------
 -- | A sum type enumerating allowed types inside of an inline context.
@@ -196,33 +142,10 @@ data Inline =
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable, Binary, NFData)
 
-instance FromJSON Inline where
-    parseJSON = withObject "Inline" $ \o -> do
-        ty <- o .: "type"
-        case ty :: Text of
-            "break" -> pure Break
-            "tag"   -> InlineTag <$> o .: "value"
-            "text"  -> InlineText <$> o .: "value"
-            _       -> fail $ "unknown inline type: " <> show ty
-
-instance ToJSON Inline where
-    toEncoding i = pairs . mconcat $ case i of
-        Break -> ["type" .= ("break" :: Text), "value" .= Aeson.Null]
-        InlineTag t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("inline" :: Text)
-            , "value" .= t
-            ]
-        InlineText t -> ["type" .= ("text" :: Text), "value" .= t]
-
-    toJSON i = object $ case i of
-        Break -> ["type" .= ("break" :: Text)]
-        InlineTag t ->
-            [ "type" .= ("tag" :: Text)
-            , "subtype" .= ("inline" :: Text)
-            , "value" .= t
-            ]
-        InlineText t -> ["type" .= ("text" :: Text), "value" .= t]
+instance Pretty Inline where
+    pretty Break            = "\9248"
+    pretty (InlineTag  tag) = pretty tag
+    pretty (InlineText f  ) = pretty f
 
 -------------------------------------------------------------------------------
 -- | A set of properties and settings, associated with a 'Region'. 
@@ -241,19 +164,21 @@ data Metadata = Metadata
 instance Monoid Metadata where
     mempty = Metadata mempty mempty
 
+instance Pretty Metadata where
+    pretty (Metadata props sets)
+        | null props && null sets
+        = "∅"
+        | otherwise
+        = let props' = fmap pretty . toList $ props
+              sets' =
+                      fmap (\(k, v) -> pretty k <+> PP.equals <+> pretty v)
+                          . toEntries
+                          $ sets
+          in  PP.list $ props' ++ sets'
+
 instance Semigroup Metadata where
     Metadata p1 s1 <> Metadata p2 s2 = Metadata (p1 <> p2) (s1 <> s2)
 
-instance FromJSON Metadata where
-    parseJSON = withObject "Metadata"
-        $ \o -> Metadata <$> o .: "properties" <*> o .: "settings"
-
-instance ToJSON Metadata where
-    toEncoding (Metadata ps ss) =
-        pairs $ mconcat ["properties" .= ps, "settings" .= ss]
-
-    toJSON (Metadata ps ss) = object ["properties" .= ps, "settings" .= ss]
-
 -------------------------------------------------------------------------------
 -- | A non-empty collection of 'Inline' items. A 'Paragraph' represents the
 -- border between block and inline contexts. All ancestors of a paragraph are
@@ -265,12 +190,8 @@ data Paragraph = Paragraph
   deriving stock (Eq, Show, Generic)
   deriving anyclass (Hashable, NFData, Binary)
 
-instance FromJSON Paragraph where
-    parseJSON = fmap (flip Paragraph Nothing) . parseJSON
-
-instance ToJSON Paragraph where
-    toEncoding (Paragraph s _) = toEncoding s
-    toJSON (Paragraph s _) = toJSON s
+instance Pretty Paragraph where
+    pretty pg = "¶" PP.<+> pretty (paragraphContent pg)
 
 -------------------------------------------------------------------------------
 -- | An untagged structural grouping of items with type @a@. Regions do not
@@ -283,8 +204,8 @@ data Region a = Region
   deriving stock (Eq, Foldable, Functor, Show, Traversable, Generic)
   deriving anyclass (Hashable, NFData, Binary)
 
-instance ToJSON a => ToJSON (Region a) where
-    toJSON (Region md ct _) = Aeson.object ["metadata" .= md, "content" .= ct]
+instance Pretty a => Pretty (Region a) where
+    pretty (Region md ct _) = PP.nest 4 $ PP.vsep ["§", pretty md, pretty ct]
 
 -------------------------------------------------------------------------------
 -- | A 'Region', annotated with a tag name.
@@ -297,23 +218,9 @@ data Tag a = Tag
   deriving stock (Eq, Foldable, Functor, Show, Traversable, Generic)
   deriving anyclass (Hashable, NFData, Binary)
 
-instance FromJSON a => FromJSON (Tag a) where
-    parseJSON = withObject "Tag" $ \o ->
-        Tag
-            <$> o
-            .:  "name"
-            <*> o
-            .:  "metadata"
-            <*> o
-            .:  "content"
-            <*> pure Nothing
-
-instance ToJSON a => ToJSON (Tag a) where
-    toEncoding (Tag nm md ct _) =
-        pairs $ mconcat ["name" .= nm, "metadata" .= md, "content" .= ct]
-
-    toJSON (Tag nm md ct _) =
-        object ["name" .= nm, "metadata" .= md, "content" .= ct]
+instance Pretty a => Pretty (Tag a) where
+    pretty (Tag name md ct _) =
+        PP.nest 4 $ PP.vsep [pretty name, pretty md, pretty ct]
 
 -- | A 'Tag' containing zero or more 'Block' items. 
 -- Specified in Prosidy source with the @#-@ sigil.

src/Prosidy/Types/Assoc.hs

@@ -5,21 +5,25 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
-{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Prosidy.Types.Assoc (Assoc(..), asHashMap, fromHashMap, toHashMap) where
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Prosidy.Types.Assoc
+    ( Assoc(..)
+    , asHashMap
+    , fromHashMap
+    , toHashMap
+    , toEntries
+    )
+where
+
+import           Prosidy.Internal.Classes
 
 import           Data.HashMap.Strict            ( HashMap )
-import           GHC.Generics                   ( Generic )
-import           Data.Aeson                     ( ToJSON(..)
-                                                , FromJSON(..)
-                                                )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary(..) )
-import           Data.Hashable                  ( Hashable(..) )
 
 import qualified Data.HashMap.Strict           as HM
+import qualified Data.Text.Prettyprint.Doc     as PP
 
 -- | An associative mapping of keys to values.
 --
@@ -28,14 +32,21 @@ import qualified Data.HashMap.Strict           as HM
 -- 1) Add non-orphan instances to the underlying structure.
 -- 2) Change the underlying type if needed.
 newtype Assoc k v = Assoc (HashMap k v)
-  deriving stock (Generic)
-  deriving newtype (Eq, Foldable, Functor, Show, ToJSON, FromJSON, NFData, Semigroup, Monoid, Hashable)
+  deriving (Generic)
+  deriving (Eq, Show, ToJSON, FromJSON, NFData, Semigroup, Monoid, Hashable) via HashMap k v
+  deriving (Foldable, Functor) via HashMap k
 
 instance (Eq k, Hashable k, Binary k, Binary v) => Binary (Assoc k v) where
     get = Assoc . HM.fromList <$> get
 
     put (Assoc hm) = put $ HM.toList hm
 
+instance (Pretty k, Pretty v) => Pretty (Assoc k v) where
+    pretty (Assoc hm) =
+        PP.list
+            . map (\(k, v) -> pretty k PP.<+> PP.equals PP.<+> pretty v)
+            $ HM.toList hm
+
 -- | Given a function which operates on a 'HashMap', return a function which
 -- performs an equivalent transfromation on an 'Assoc'.
 asHashMap
@@ -52,3 +63,7 @@ fromHashMap = Assoc
 -- | Convert an 'Assoc' to a 'HashMap'.
 toHashMap :: Assoc k v -> HashMap k v
 toHashMap (Assoc hm) = hm
+
+-- | Convert an 'Assoc' into a list of key/value pairs.
+toEntries :: Assoc k v -> [(k, v)]
+toEntries (Assoc hm) = HM.toList hm

src/Prosidy/Types/Key.hs

@@ -5,24 +5,10 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE GADTSyntax #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Types.Key
     ( -- * The 'Key' type.
       Key
@@ -39,16 +25,9 @@ module Prosidy.Types.Key
     )
 where
 
+import           Prosidy.Internal.Classes
+
 import           Data.Text                      ( Text )
-import           Data.Aeson                     ( ToJSON(..)
-                                                , ToJSONKey(..)
-                                                , FromJSON(..)
-                                                , FromJSONKey(..)
-                                                )
-import           GHC.Generics                   ( Generic )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary )
-import           Data.Hashable                  ( Hashable )
 import           Data.String                    ( IsString(..) )
 import           Data.Foldable                  ( for_ )
 import           Control.Monad                  ( unless )
@@ -56,15 +35,14 @@ import           Control.Exception              ( Exception(..)
                                                 , throw
                                                 )
 
-import qualified Data.Aeson                    as Aeson
 import qualified Data.Char                     as Char
 import qualified Data.Set                      as Set
 import qualified Data.Text                     as Text
 
 -- | A 'Key' is an identifier used in tags, properties, and setting names.
 newtype Key = Key Text
-  deriving stock (Generic)
-  deriving newtype (Binary, Eq, Hashable, NFData, Ord, Show, ToJSON, ToJSONKey)
+  deriving stock (Show, Generic)
+  deriving (Binary, Eq, Hashable, NFData, Ord, ToJSON, ToJSONKey) via Text
 
 -- | 'Key' exposes an 'IsString' instance, but beware! Invalid strings will
 -- throw a pure exception. 
@@ -76,11 +54,8 @@ instance FromJSON Key where
         text <- parseJSON json
         either (fail . displayException) pure $ makeKey text
 
-instance FromJSONKey Key where
-    fromJSONKey =
-        Aeson.FromJSONKeyTextParser
-            $ either (fail . displayException) pure
-            . makeKey
+instance Pretty Key where
+    pretty = pretty . rawKey
 
 -- | Create a new 'Key', checking its validity.
 makeKey :: Text -> Either KeyError Key

src/Prosidy/Types/Series.hs

@@ -5,11 +5,11 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Types.Series
     ( -- * Possibly empty collections
       Series(..)
@@ -30,14 +30,9 @@ module Prosidy.Types.Series
     )
 where
 
+import Prosidy.Internal.Classes
+
 import           Data.Sequence                  ( Seq )
-import           GHC.Generics                   ( Generic )
-import           Data.Aeson                     ( ToJSON(..)
-                                                , FromJSON(..)
-                                                )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary(..) )
-import           Data.Hashable                  ( Hashable(..) )
 import           Data.Foldable                  ( toList
                                                 , foldl'
                                                 )
@@ -45,15 +40,14 @@ import           Control.Monad                  ( guard )
 
 import qualified Data.Sequence                 as Seq
 
-{-# ANN module "nofmt" #-}
-
 -- | A newtype wrapper around a sequential collection.
 --
 -- Currently, 'Series' is implemented as a 'Seq', but this is not guarenteed to
 -- be true.
 newtype Series a = Series (Seq a)
-  deriving stock (Generic, Show)
-  deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, FromJSON, NFData, Semigroup, Monoid)
+  deriving (Generic, Show)
+  deriving (Eq, ToJSON, FromJSON, NFData, Semigroup, Monoid) via Seq a
+  deriving (Foldable, Functor, Applicative) via Seq
 
 instance Binary a => Binary (Series a) where
     get = Series . Seq.fromList <$> get
@@ -65,13 +59,17 @@ instance Binary a => Binary (Series a) where
 instance Hashable a => Hashable (Series a) where
     hashWithSalt salt (Series xs) = foldl' hashWithSalt salt xs
 
+instance Pretty a => Pretty (Series a) where
+    pretty = pretty . toList
+
 instance Traversable Series where
     traverse f (Series xs) = Series <$> traverse f xs
 
 -- | A non-empty 'Series'.
 newtype SeriesNE a = SeriesNE (Seq a)
-  deriving stock (Generic, Show)
-  deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, NFData, Semigroup)
+  deriving (Generic, Show)
+  deriving (Eq, ToJSON, NFData, Semigroup) via Seq a
+  deriving (Foldable, Functor, Applicative) via Seq
 
 instance Binary a => Binary (SeriesNE a) where
     get =
@@ -93,6 +91,9 @@ instance FromJSON a => FromJSON (SeriesNE a) where
 instance Hashable a => Hashable (SeriesNE a) where
     hashWithSalt salt (SeriesNE xs) = foldl' hashWithSalt salt xs
 
+instance Pretty a => Pretty (SeriesNE a) where
+    pretty = pretty . toList
+
 instance Traversable SeriesNE where
     traverse f (SeriesNE xs) = SeriesNE <$> traverse f xs
 
@@ -161,4 +162,4 @@ fromSeqNE s | otherwise = Just (SeriesNE s)
 -- | Convert a 'SeriesNE' into a 'Seq'. The returned 'Seq' is guarenteed to
 -- always contain at least one element.
 toSeqNE :: SeriesNE a -> Seq a
-toSeqNE (SeriesNE a) = a
+toSeqNE (SeriesNE a) = a

src/Prosidy/Types/Set.hs

@@ -5,46 +5,34 @@ Copyright   : ©2020 James Alexander Feldman-Crough
 License     : MPL-2.0
 Maintainer  : alex@fldcr.com
 -}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE Safe #-}
 module Prosidy.Types.Set (Set(..), asHashSet, fromHashSet, toHashSet) where
 
+import           Prosidy.Internal.Classes
+
 import           Data.HashSet                   ( HashSet )
-import           GHC.Generics                   ( Generic )
-import           Data.Aeson                     ( FromJSONKey
-                                                , ToJSONKey
-                                                , ToJSON(..)
-                                                , FromJSON(..)
-                                                )
-import           Control.DeepSeq                ( NFData )
-import           Data.Binary                    ( Binary(..) )
-import           Data.Hashable                  ( Hashable(..) )
 import qualified Data.HashSet                  as HS
-import qualified Data.HashMap.Strict           as HM
 
 -- | A newtype wrapper around an unordered collection of unique elements.
 --
 -- Currently, this is implemented as a wrapper around a 'HashSet'.
 newtype Set a = Set (HashSet a)
   deriving stock (Generic)
-  deriving newtype (Eq, Foldable, Show, NFData, Semigroup, Monoid, Hashable)
-
-instance (Hashable a, Eq a, ToJSONKey a) => ToJSON (Set a) where
-    toJSON (Set hs) = toJSON $ foldMap (flip HM.singleton True) hs
-    toEncoding (Set hs) = toEncoding $ foldMap (flip HM.singleton True) hs
-
-instance (Hashable a, Eq a, FromJSONKey a) => FromJSON (Set a) where
-    parseJSON json = do
-        m <- parseJSON json
-        pure . Set . HM.keysSet $ HM.filter id m
+  deriving (Eq, Show, NFData, Semigroup, Monoid, Hashable) via HashSet a
+  deriving Foldable via HashSet
 
 instance (Eq a, Hashable a, Binary a) => Binary (Set a) where
     get = Set . HS.fromList <$> get
 
     put (Set s) = put $ HS.toList s
 
+instance Pretty a => Pretty (Set a) where
+    pretty = pretty . HS.toList . toHashSet
+
 -- | Given a function which operates on 'HashSet's, return a function which
 -- performs the same operation on a 'Set'.
 asHashSet :: Functor f => (HashSet a -> f (HashSet b)) -> Set a -> f (Set b)