static-text (empty) → 0.2
raw patch · 9 files changed
+699/−0 lines, 9 filesdep +basedep +bytestringdep +doctestsetup-changed
Dependencies added: base, bytestring, doctest, doctest-discover, static-text, tasty, tasty-hunit, template-haskell, text, vector
Files
- CHANGELOG.md +64/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Data/StaticText.hs +242/−0
- src/Data/StaticText/Class.hs +173/−0
- src/Data/StaticText/TH.hs +60/−0
- static-text.cabal +91/−0
- tests/Main.hs +36/−0
- tests/doctest-driver.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,64 @@+# Changelog++## [Unreleased]++## [0.2.0] - 2018-02-17++### Changed++- Package renamed to `static-text` as per+ <https://github.com/dzhus/static-text/issues/2>. Old names were+ changed as follows:++ | before | after |+ |--------------|-------------------|+ | `Data.Sext` | `Data.StaticText` |+ | `Sext n a` | `Static a n` |+ | `Sextable a` | `IsStaticText a` |+ | `$(sext ..)` | `$(st ..)` |++## [0.1.3.1] - 2017-10-29++### Added++- GHC 8.2.x support++## [0.1.3] - 2017-03-26++### Added++- `ShortByteString` support++### Fixed++- A bug in `createLeft` which failed to actually pad/truncate strings+ (reported by Altai-man <https://github.com/dzhus/static-text/issues/4>)++## [0.1.2] - 2017-01-18++### Added++- `Vector` support, `Eq` and `Ord` instances (contributed by Dylan+ Simon <https://github.com/dzhus/static-text/pull/3>)++## [0.1.1] - 2016-19-12++### Added++- GHC 8.0.x support++## [0.1.0.2] - 2015-12-06++### Added++- GHC 7.10.x support++## [0.1.0.0] - 2014-08-10++[0.2.0]: https://github.com/dzhus/static-text/compare/0.1.3.1...0.2.0+[0.1.3.1]: https://github.com/dzhus/static-text/compare/0.1.3...0.1.3.1+[0.1.3]: https://github.com/dzhus/static-text/compare/0.1.2...0.1.3+[0.1.2]: https://github.com/dzhus/static-text/compare/0.1.1...0.1.2+[0.1.1]: https://github.com/dzhus/static-text/compare/0.1.0.2...0.1.1+[0.1.0.2]: https://github.com/dzhus/static-text/compare/0.1.0.0...0.1.0.2+[0.1.0.0]: https://github.com/dzhus/static-text/tree/0.1.0.0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014-2018, Dmitry Dzhus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dmitry Dzhus nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/StaticText.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+#endif++{-|++static-text provides type-level safety for basic operations on+string-like types (finite lists of elements), such as "Data.Text",+"String" (and all lists), "Data.ByteString" and "Data.Vector". Use it+when you need static guarantee on lengths of strings produced in your+code.++An example application would be a network exchange protocol built of+packets with fixed-width fields:++@+{\-\# LANGUAGE DataKinds #-\}+{\-\# LANGUAGE OverloadedStrings #-\}+{\-\# LANGUAGE TemplateHaskell #-\}+@++> import Data.StaticText+>+> mkPacket :: ByteString -> Static 32 ByteString+> mkPacket inp =+> -- 5-character version signature+> $(st "PKT10") `append`+> -- 25-character payload+> payload `append`+> -- 2-character payload checksum+> checksum+> where+> payload = createLeft 0x20 inp+> checksum :: Static 2 ByteString+> checksum = createLeft 0x20 $+> pack $ show $ Data.Static.length payload `mod` 100+>+> message :: Static 64 ByteString+> message = mkPacket "Hello" `append` mkPacket "world"++static-text combinators are defined for members of 'IsStaticText'+class. The package includes 'IsStaticText' instances for several+common types.++This module is meant to be imported qualifed, e.g.++> import qualified Data.StaticText as S++-}++module Data.StaticText+ (+ -- * Constructing StaticTexts+ --+ -- | See also 'C.unsafeCreate'+ createLeft+ , createRight+ , st+ , create+ , replicate++ -- * Working with StaticTexts+ , append+ , take+ , drop+ , map+ , padLeft+ , padRight++ , length++ -- * IsStaticText class+ , Static+ , IsStaticText(Elem, unsafeCreate, unwrap)+ )++where++import Prelude as P hiding (drop, length, map, replicate, take)++import GHC.TypeLits++import Data.Proxy+import Data.StaticText.Class (Elem, Static, IsStaticText)+import qualified Data.StaticText.Class as C+import Data.StaticText.TH+++-- $setup+-- >>> :set -XDataKinds+-- >>> :set -XTemplateHaskell+-- >>> :set -XOverloadedStrings+-- >>> import Data.Char (toUpper)+++-- | Safely create a Static, possibly altering the source to match+-- target length. If target length is less than that of the source,+-- the source gets truncated. If target length is greater, the source+-- is padded using the provided basic element. Elements on the left+-- are preferred.+--+-- >>> createLeft ' ' "foobarbaz" :: Static String 6+-- "foobar"+-- >>> createLeft '#' "foobarbaz" :: Static String 12+-- "foobarbaz###"+createLeft :: forall a i.+ (IsStaticText a, KnownNat i) =>+ Elem a -> a -> Static a i+createLeft e s =+ C.unsafeCreate $+ C.take t $+ C.append s $+ C.replicate (t - C.length s) e+ where+ t = fromIntegral $ natVal (Proxy :: Proxy i)+++-- | Just like 'createLeft', except that elements on the right are preferred.+--+-- >>> createRight '@' "foobarbaz" :: Static String 6+-- "barbaz"+-- >>> createRight '!' "foobarbaz" :: Static String 12+-- "!!!foobarbaz"+createRight :: forall a i.+ (IsStaticText a, KnownNat i) =>+ Elem a -> a -> Static a i+createRight e s =+ C.unsafeCreate $+ C.drop (C.length s - t) $+ C.append (C.replicate (t - C.length s) e) s+ where+ t = fromIntegral $ natVal (Proxy :: Proxy i)+++-- | Attempt to safely create a Static if it matches target length.+--+-- >>> create "foobar" :: Maybe (Static String 6)+-- Just "foobar"+-- >>> create "barbaz" :: Maybe (Static String 8)+-- Nothing+--+-- This is safer than 'C.unsafeCreate' and unlike with 'createLeft' /+-- 'createRight' the source value is left unchanged. However, this+-- implies a further run-time check for Nothing values.+create :: forall a i.+ (IsStaticText a, KnownNat i) =>+ a -> P.Maybe (Static a i)+create s =+ if C.length s == t+ then Just $ C.unsafeCreate s+ else Nothing+ where+ t = fromIntegral $ natVal (Proxy :: Proxy i)+++-- | Append two Statics together.+--+-- >>> append $(st "foo") $(st "bar") :: Static String 6+-- "foobar"+append :: forall a m n.+ (IsStaticText a) => Static a m -> Static a n -> Static a (m + n)+append a b = C.unsafeCreate $ C.append (C.unwrap a) (C.unwrap b)+++-- | Construct a new Static from a basic element.+--+-- >>> replicate '=' :: Static String 10+-- "=========="+replicate :: forall a i.+ (IsStaticText a, KnownNat i) => Elem a -> Static a i+replicate e =+ C.unsafeCreate $ C.replicate t e+ where+ t = fromIntegral $ natVal (Proxy :: Proxy i)+++-- | Map a Static to a Static of the same length.+--+-- >>> map toUpper $(st "Hello") :: Static String 5+-- "HELLO"+map :: IsStaticText a =>+ (Elem a -> Elem a) -> Static a m -> Static a m+map f s =+ C.unsafeCreate $ C.map f $ C.unwrap s+++-- | Reduce Static length, preferring elements on the left.+--+-- >>> take $(st "Foobar") :: Static String 3+-- "Foo"+take :: forall a m n.+ (IsStaticText a, KnownNat m, KnownNat n, n <= m) =>+ Static a m -> Static a n+take s =+ C.unsafeCreate $ C.take t $ C.unwrap s+ where+ t = fromIntegral $ natVal (Proxy :: Proxy n)+++-- | Reduce Static length, preferring elements on the right.+--+-- >>> drop $(st "Foobar") :: Static String 2+-- "ar"+drop :: forall a m n.+ (IsStaticText a, KnownNat m, KnownNat n, n <= m) =>+ Static a m -> Static a n+drop s =+ C.unsafeCreate $ C.drop (C.length s' - t) s'+ where+ s' = C.unwrap s+ t = fromIntegral $ natVal (Proxy :: Proxy n)+++-- | Obtain value-level length.+length :: forall a m.+ KnownNat m => Static a m -> P.Int+length _ = P.fromIntegral P.$ natVal (Proxy :: Proxy m)+++-- | Fill a Static with extra elements up to target length, padding+-- original elements to the left.+padLeft :: forall a m n.+ (IsStaticText a, KnownNat m, KnownNat (n - m),+ n ~ (n - m + m), m <= n) =>+ Elem a -> Static a m -> Static a n+padLeft pad = append (replicate pad)+++-- | Like 'padLeft', but original elements are padded to the right.+padRight :: forall a m n.+ (IsStaticText a, KnownNat m, KnownNat (n - m),+ n ~ (m + (n - m)), m <= n) =>+ Elem a -> Static a m -> Static a n+padRight pad = P.flip append (replicate pad)
+ src/Data/StaticText/Class.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}++{-|++Use this module when you need to add an 'IsStaticText' instance to a+type.++-}++module Data.StaticText.Class+ ( IsStaticText(..)+ )++where++import Prelude+import qualified Prelude as P++#ifdef WITH_BS+import qualified Data.ByteString as B+import GHC.Word+import qualified Data.ByteString.Short as BS+#endif++#ifdef WITH_TEXT+import qualified Data.Text as T+#endif++#ifdef WITH_VECTOR+import qualified Data.Vector as V+#endif++#if MIN_VERSION_base(4,9,0)+import GHC.TypeLits hiding (Text)+#else+import GHC.TypeLits+#endif+++-- | Class of types which can be assigned a type-level length.+class IsStaticText a where+ -- | Data family which wraps values of the underlying type giving+ -- them a type-level length. @Static t 6@ means a value of type @t@ of+ -- length 6.+ data Static a (i :: Nat)++ -- | Basic element type. For @IsStaticText [a]@, this is @a@.+ type Elem a++ -- | Simply wrap a value in a Static as is, assuming any length.+ --+ -- For example, an expression like+ --+ -- > unsafeCreate "somestring" :: Static 50 String+ --+ -- will typecheck, although the stored length information will not+ -- match actual string size. This may result in wrong behaviour of+ -- all functions defined for Static.+ --+ -- Use it only when you know what you're doing.+ --+ -- When implementing new IsStaticText instances, code this to simply+ -- apply the constructor of 'StaticText'.+ unsafeCreate :: a -> Static a i++ -- | Forget type-level length, obtaining the underlying value.+ unwrap :: Static a i -> a++ length :: a -> Int+ append :: a -> a -> a+ replicate :: Int -> Elem a -> a+ map :: (Elem a -> Elem a) -> a -> a+ take :: Int -> a -> a+ drop :: Int -> a -> a+++instance (Show a, IsStaticText a) => Show (Static a i) where+ show = show . unwrap+ showsPrec p = showsPrec p . unwrap+++instance IsStaticText [a] where+ type Elem [a] = a++ data Static [a] i = List [a]+ deriving (Eq, Ord)++ unsafeCreate = List+ unwrap (List l) = l++ length = P.length+ append = (P.++)+ replicate = P.replicate+ map = P.map+ take = P.take+ drop = P.drop+++#ifdef WITH_TEXT+instance IsStaticText T.Text where+ type Elem T.Text = Char++ data Static T.Text i = Text T.Text+ deriving (Eq, Ord)++ unsafeCreate = Text+ unwrap (Text t) = t++ length = T.length+ append = T.append+ replicate = \n c -> T.replicate n (T.singleton c)+ map = T.map+ take = T.take+ drop = T.drop+#endif+++#ifdef WITH_BS+instance IsStaticText B.ByteString where+ type Elem B.ByteString = Word8++ data Static B.ByteString i = ByteString B.ByteString+ deriving (Eq, Ord)++ unsafeCreate = ByteString+ unwrap (ByteString t) = t++ length = B.length+ append = B.append+ replicate = B.replicate+ map = B.map+ take = B.take+ drop = B.drop++-- | IsStaticText instance for 'BS.ShortByteString' uses intermediate+-- 'B.ByteString's (pinned) for all modification operations.+instance IsStaticText BS.ShortByteString where+ type Elem BS.ShortByteString = Word8++ data Static BS.ShortByteString i = ByteStringS BS.ShortByteString+ deriving (Eq, Ord)++ unsafeCreate = ByteStringS+ unwrap (ByteStringS t) = t++ length = BS.length+ append a b = BS.toShort $ B.append (BS.fromShort a) (BS.fromShort b)+ replicate n = BS.toShort . B.replicate n+ map f = BS.toShort . B.map f . BS.fromShort+ take n = BS.toShort . B.take n . BS.fromShort+ drop n = BS.toShort . B.drop n . BS.fromShort+#endif+++#ifdef WITH_VECTOR+instance IsStaticText (V.Vector a) where+ type Elem (V.Vector a) = a++ data Static (V.Vector a) i = Vector (V.Vector a)+ deriving (Eq, Ord)++ unsafeCreate = Vector+ unwrap (Vector t) = t++ length = V.length+ append = (V.++)+ replicate = V.replicate+ map = V.map+ take = V.take+ drop = V.drop+#endif
+ src/Data/StaticText/TH.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++Template Haskell helpers for StaticText.++-}++module Data.StaticText.TH+ ( st+ )++where++import Prelude+import qualified Prelude as P (length)++import Data.StaticText.Class+import Data.String++import Language.Haskell.TH+++-- | A type with IsString instance to allow string literals in 'st'+-- argument without quoting.+newtype LitS = LitS String deriving IsString+++-- | Type-safe StaticText constructor macro for string literals.+--+-- Example:+--+-- > $(st "Foobar")+--+-- compiles to+--+-- > unsafeCreate "Foobar" :: forall a. (IsString a, IsStaticText a) => StaticText 6 a+--+-- where 6 is the string length obtained at compile time.+st :: LitS -> Q Exp+st (LitS s) =+ do+ at <- newName "a"+ return $ SigE (AppE (VarE 'unsafeCreate) (LitE $ StringL s))+ (ForallT+ [PlainTV at]+#if MIN_VERSION_template_haskell(2,10,0)+ [ AppT (ConT ''IsString) (VarT at)+ , AppT (ConT ''IsStaticText) (VarT at)] $+#else+ [ ClassP ''IsString [VarT at]+ , ClassP ''IsStaticText [VarT at]] $+#endif+ AppT+ (AppT+ (ConT ''Static)+ (VarT at))+ (LitT $ NumTyLit (fromIntegral $ P.length s)))
+ static-text.cabal view
@@ -0,0 +1,91 @@+name: static-text+version: 0.2+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: dima@dzhus.org+homepage: https://github.com/dzhus/static-text#readme+bug-reports: https://github.com/dzhus/static-text/issues+synopsis: Lists, Texts, ByteStrings and Vectors of statically known length+description:+ static-text provides type-level safety for basic operations on string-like types (finite lists of elements), such as Data.Text, String (and all lists), Data.ByteString and Data.Vector. Use it when you need static guarantee on lengths of strings produced in your code.+category: Data, Text, Type System+author: Dmitry Dzhus+extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/dzhus/static-text++flag bytestring+ description:+ Build interface for ByteString++flag text+ description:+ Build interface for Text++flag vector+ description:+ Build interface for Vector++library+ + if flag(bytestring)+ build-depends:+ bytestring <0.11+ cpp-options: -DWITH_BS+ + if flag(text)+ build-depends:+ text <1.3+ cpp-options: -DWITH_TEXT+ + if flag(vector)+ build-depends:+ vector <0.13+ cpp-options: -DWITH_VECTOR+ exposed-modules:+ Data.StaticText+ Data.StaticText.Class+ Data.StaticText.TH+ build-depends:+ base <5,+ template-haskell <2.13+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules:+ Paths_static_text+ ghc-options: -Wall++test-suite static-text-doctests+ type: exitcode-stdio-1.0+ main-is: doctest-driver.hs+ build-depends:+ base <5,+ doctest <0.14,+ doctest-discover <0.2,+ template-haskell <2.13+ default-language: Haskell2010+ hs-source-dirs: tests+ other-modules:+ Main+ Paths_static_text+ ghc-options: -Wall -threaded+test-suite static-text-example+ type: exitcode-stdio-1.0+ main-is: Main.hs+ build-depends:+ base <5,+ bytestring <0.11,+ static-text -any,+ tasty <0.13,+ tasty-hunit <0.11,+ template-haskell <2.13+ default-language: Haskell2010+ hs-source-dirs: tests+ other-modules:+ Paths_static_text+ ghc-options: -Wall
+ tests/Main.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++import Data.ByteString.Char8 (ByteString, length, pack)+import Data.Typeable+import Test.Tasty+import Test.Tasty.HUnit++import Data.StaticText++mkPacket :: ByteString -> Static ByteString 32+mkPacket inp =+ -- 5-character version signature+ $(st "PKT10") `append`+ -- 25-character payload+ payload `append`+ -- 2-character payload checksum+ checksum+ where+ payload = createLeft 0x20 inp+ checksum :: Static ByteString 2+ checksum = createLeft 0x20 $+ pack $ show $ Data.StaticText.length payload `mod` 100++message :: Static ByteString 64+message = mkPacket "Hello" `append` mkPacket "world"++tests :: [TestTree]+tests =+ [ testCase ("The actual length of " ++ show (typeOf message)) $+ assertEqual "" 64 (Data.ByteString.Char8.length $ unwrap message)+ ]++main :: IO ()+main = defaultMain $ testGroup "Tests" tests
+ tests/doctest-driver.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}