Skip to content

Commit

Permalink
[#171] Specify custom type errors for Text functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@chshersh
chshersh committed Oct 16, 2019
1 parent 47524d3 commit 7bb663c
Show file tree
Hide file tree
Showing 2 changed files with 236 additions and 16 deletions.
69 changes: 56 additions & 13 deletions src/Relude/List/Reexport.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,16 +36,17 @@ module Relude.List.Reexport
, tail
) where

import Data.Kind (Type)
import Data.List (break, cycle, drop, dropWhile, filter, genericDrop, genericLength,
genericReplicate, genericSplitAt, genericTake, group, inits, intercalate,
intersperse, isPrefixOf, iterate, map, permutations, repeat, replicate, reverse,
scanl, scanr, sort, sortBy, sortOn, splitAt, subsequences, tails, take, takeWhile,
transpose, uncons, unfoldr, unzip, unzip3, zip, zip3, zipWith, (++))
import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
import GHC.Exts (Constraint, sortWith)
import GHC.Exts (sortWith)
import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)

import Relude.Base (Constraint, Type)

import qualified Data.List.NonEmpty as NE (head, init, last, tail)


Expand All @@ -61,10 +62,16 @@ type IsNonEmpty
(fun :: Symbol) -- Function name
= (f ~ NonEmpty, CheckNonEmpty f a res fun)

type family CheckNonEmpty (f :: Type -> Type) (a :: Type) (res ::Type) (fun :: Symbol) :: Constraint where
type family CheckNonEmpty
(f :: Type -> Type)
(a :: Type)
(res :: Type)
(fun :: Symbol)
:: Constraint
where
CheckNonEmpty NonEmpty _ _ _ = ()
CheckNonEmpty [] a res fun = TypeError
( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' is working with 'NonEmpty', not ordinary lists."
( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'NonEmpty', not ordinary lists."
':$$: 'Text "Possible fix:"
':$$: 'Text " Replace: [" ':<>: 'ShowType a ':<>: 'Text "]"
':$$: 'Text " With: NonEmpty " ':<>: 'ShowType a
Expand All @@ -78,19 +85,27 @@ type family CheckNonEmpty (f :: Type -> Type) (a :: Type) (res ::Type) (fun :: S
CheckNonEmpty _ a _ fun = TypeError
( 'Text "'"
':<>: 'Text fun
':<>: 'Text "' is working with 'NonEmpty "
':<>: 'Text "' works with 'NonEmpty "
':<>: 'ShowType a
':<>: 'Text "' lists"
)


{- | @O(1)@. Extracts the first element of a 'NonEmpty' list.
Actual type of this function is the following:
@
head :: 'NonEmpty' a -> a
@
but it was given a more complex type to provide frienlier compile time errors.
>>> head ('a' :| "bcde")
'a'
>>> head [0..5 :: Int]
...
... 'head' is working with 'NonEmpty', not ordinary lists.
... 'head' works with 'NonEmpty', not ordinary lists.
Possible fix:
Replace: [Int]
With: NonEmpty Int
Expand All @@ -103,20 +118,29 @@ type family CheckNonEmpty (f :: Type -> Type) (a :: Type) (res ::Type) (fun :: S
...
>>> head (Just 'a')
...
... 'head' is working with 'NonEmpty Char' lists
... 'head' works with 'NonEmpty Char' lists
...
-}
head :: IsNonEmpty f a a "head" => f a -> a
head = NE.head
{-# INLINE head #-}

{- | @O(n)@. Return all the elements of a 'NonEmpty' list except the last one
element.
Actual type of this function is the following:
@
init :: 'NonEmpty' a -> [a]
@
but it was given a more complex type to provide frienlier compile time errors.
>>> init ('a' :| "bcde")
"abcd"
>>> init [0..5 :: Int]
...
... 'init' is working with 'NonEmpty', not ordinary lists.
... 'init' works with 'NonEmpty', not ordinary lists.
Possible fix:
Replace: [Int]
With: NonEmpty Int
Expand All @@ -129,19 +153,28 @@ element.
...
>>> init (Just 'a')
...
... 'init' is working with 'NonEmpty Char' lists
... 'init' works with 'NonEmpty Char' lists
...
-}
init :: IsNonEmpty f a [a] "init" => f a -> [a]
init = NE.init
{-# INLINE init #-}

{- | @O(n)@. Extracts the last element of a 'NonEmpty' list.
Actual type of this function is the following:
@
last :: 'NonEmpty' a -> a
@
but it was given a more complex type to provide frienlier compile time errors.
>>> last ('a' :| "bcde")
'e'
>>> last [0..5 :: Int]
...
... 'last' is working with 'NonEmpty', not ordinary lists.
... 'last' works with 'NonEmpty', not ordinary lists.
Possible fix:
Replace: [Int]
With: NonEmpty Int
Expand All @@ -154,20 +187,29 @@ init = NE.init
...
>>> last (Just 'a')
...
... 'last' is working with 'NonEmpty Char' lists
... 'last' works with 'NonEmpty Char' lists
...
-}
last :: IsNonEmpty f a a "last" => f a -> a
last = NE.last
{-# INLINE last #-}

{- | @O(1)@. Return all the elements of a 'NonEmpty' list after the head
element.
Actual type of this function is the following:
@
tail :: 'NonEmpty' a -> [a]
@
but it was given a more complex type to provide frienlier compile time errors.
>>> tail ('a' :| "bcde")
"bcde"
>>> tail [0..5 :: Int]
...
... 'tail' is working with 'NonEmpty', not ordinary lists.
... 'tail' works with 'NonEmpty', not ordinary lists.
Possible fix:
Replace: [Int]
With: NonEmpty Int
Expand All @@ -180,8 +222,9 @@ element.
...
>>> tail (Just 'a')
...
... 'tail' is working with 'NonEmpty Char' lists
... 'tail' works with 'NonEmpty Char' lists
...
-}
tail :: IsNonEmpty f a [a] "tail" => f a -> [a]
tail = NE.tail
{-# INLINE tail #-}
183 changes: 180 additions & 3 deletions src/Relude/String/Reexport.hs
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,11 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Copyright: (c) 2016 Stephen Diehl
(c) 2016-2018 Serokell
Expand All @@ -12,12 +20,16 @@ and 'ShortByteString' types.
module Relude.String.Reexport
( -- * String
module Data.String
, module Text.Read

-- * Text
, module Data.Text
, Text
, lines
, unlines
, words
, unwords
, module Data.Text.Encoding
, module Data.Text.Encoding.Error
, module Text.Read

-- * ByteString
, ByteString
Expand All @@ -31,8 +43,173 @@ module Relude.String.Reexport
import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString, fromShort, toShort)
import Data.String (IsString (..), String)
import Data.Text (Text, lines, unlines, unwords, words)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8', decodeUtf8With)
import Data.Text.Encoding.Error (OnDecodeError, OnError, UnicodeException, lenientDecode,
strictDecode)
import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)
import Text.Read (Read, readMaybe, reads)

import Relude.Base (Constraint, Type)

import qualified Data.Text as Text


-- $setup
-- >>> import Relude

-- | For tracking usage of Text instead of String
type IsText
(t :: Type) -- Textual type, e.g. Text, String
(fun :: Symbol) -- Function name
= (t ~ Text, CheckText t fun)

type family CheckText (t :: Type) (fun :: Symbol) :: Constraint where
CheckText Text _ = ()
CheckText String fun = TypeError
( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'Text', not 'String'."
':$$: 'Text "Possible fixes:"
':$$: 'Text " 1. Make sure OverloadedStrings extension is enabled."
':$$: 'Text " 2. Apply 'toText' to a single value."
':$$: 'Text " 3. Apply 'map toText' to the list value."
)
CheckText a fun = TypeError
( 'Text "'" ':<>: 'Text fun ':<>: 'Text "' works with 'Text'"
':$$: 'Text "But given: '" ':<>: 'ShowType a ':<>: 'Text "'"
)

{- | 'lines' takes 'Text' and splits it into the list by lines.
Actual type of this function is the following:
@
lines :: 'Text' -> ['Text']
@
but it was given a more complex type to provide frienlier compile time errors.
>>> lines ""
[]
>>> lines "one line"
["one line"]
>>> lines "line 1\nline 2"
["line 1","line 2"]
>>> lines ("string line" :: String)
...
... 'lines' works with 'Text', not 'String'.
Possible fixes:
1. Make sure OverloadedStrings extension is enabled.
2. Apply 'toText' to a single value.
3. Apply 'map toText' to the list value.
...
>>> lines True
...
... 'lines' works with 'Text'
But given: 'Bool'
...
-}
lines :: IsText t "lines" => t -> [t]
lines = Text.lines
{-# INLINE lines #-}

{- | 'unlines' takes list of 'Text' values and joins them with line separator.
Actual type of this function is the following:
@
unlines :: ['Text'] -> 'Text'
@
but it was given a more complex type to provide frienlier compile time errors.
>>> unlines []
""
>>> unlines ["line 1"]
"line 1\n"
>>> unlines ["first line", "second line"]
"first line\nsecond line\n"
>>> unlines (["line 1", "line 2"] :: [String])
...
... 'unlines' works with 'Text', not 'String'.
Possible fixes:
1. Make sure OverloadedStrings extension is enabled.
2. Apply 'toText' to a single value.
3. Apply 'map toText' to the list value.
...
>>> unlines [True, False]
...
... 'unlines' works with 'Text'
But given: 'Bool'
...
-}
unlines :: IsText t "unlines" => [t] -> t
unlines = Text.unlines
{-# INLINE unlines #-}

{- | 'words' takes 'Text' and splits it into the list by words.
Actual type of this function is the following:
@
words :: 'Text' -> ['Text']
@
but it was given a more complex type to provide frienlier compile time errors.
>>> words ""
[]
>>> words "one line"
["one","line"]
>>> words " >_< "
[">_<"]
>>> words ("string words" :: String)
...
... 'words' works with 'Text', not 'String'.
Possible fixes:
1. Make sure OverloadedStrings extension is enabled.
2. Apply 'toText' to a single value.
3. Apply 'map toText' to the list value.
...
>>> words True
...
... 'words' works with 'Text'
But given: 'Bool'
...
-}
words :: IsText t "words" => t -> [t]
words = Text.words
{-# INLINE words #-}

{- | 'unwords' takes list of 'Text' values and joins them with space character.
Actual type of this function is the following:
@
unwords :: ['Text'] -> 'Text'
@
but it was given a more complex type to provide frienlier compile time errors.
>>> unwords []
""
>>> unwords ["singleWord"]
"singleWord"
>>> unwords ["word", "another"]
"word another"
>>> unwords (["word", "another"] :: [String])
...
... 'unwords' works with 'Text', not 'String'.
Possible fixes:
1. Make sure OverloadedStrings extension is enabled.
2. Apply 'toText' to a single value.
3. Apply 'map toText' to the list value.
...
>>> unwords [True, False]
...
... 'unwords' works with 'Text'
But given: 'Bool'
...
-}
unwords :: IsText t "unwords" => [t] -> t
unwords = Text.unwords
{-# INLINE unwords #-}

0 comments on commit 7bb663c

Please sign in to comment.