Skip to content
Snippets Groups Projects
Commit 3fe584f1 authored by glguy's avatar glguy
Browse files

Merge pull request #15 from frankier/add-isstring-instance

Add IsString instance for UTF8 string container type
parents 9712c3a2 f2bae1a4
No related branches found
No related tags found
No related merge requests found
...@@ -48,6 +48,7 @@ import Prelude hiding (null,take,drop,span,break ...@@ -48,6 +48,7 @@ import Prelude hiding (null,take,drop,span,break
,foldl,foldr,length,lines,splitAt) ,foldl,foldr,length,lines,splitAt)
import qualified Codec.Binary.UTF8.Generic as G import qualified Codec.Binary.UTF8.Generic as G
import Codec.Binary.UTF8.Generic (UTF8Bytes) import Codec.Binary.UTF8.Generic (UTF8Bytes)
import qualified Data.String as S
-- | The type of strings that are represented using the UTF8 encoding. -- | The type of strings that are represented using the UTF8 encoding.
-- The parameter is the type of the container for the representation. -- The parameter is the type of the container for the representation.
...@@ -56,6 +57,9 @@ newtype UTF8 string = Str string deriving (Eq,Ord) -- XXX: Is this OK? ...@@ -56,6 +57,9 @@ newtype UTF8 string = Str string deriving (Eq,Ord) -- XXX: Is this OK?
instance UTF8Bytes string index => Show (UTF8 string) where instance UTF8Bytes string index => Show (UTF8 string) where
show x = show (toString x) show x = show (toString x)
instance UTF8Bytes string index => S.IsString (UTF8 string) where
fromString = fromString
fromRep :: string -> UTF8 string fromRep :: string -> UTF8 string
fromRep = Str fromRep = Str
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment