Testing laziness of IsString s => s -> Bool function - haskell

Is there any way I can test that a function p :: IsString s => s -> Bool evaluates its input lazily? That is, it only consumes a part of its input when determining its result. And is it possible in such a way that it's compatible with both String and Data.Text.Lazy?
I've looked at the Q&A Unit-testing the undefined evaluated in lazy expression in Haskell, which doesn't cover IsString specifically, and I've found the StrictCheck package on Hackage that I'm not really sure how works. Does it apply here?
Problem
I've got a predicate,
p :: IsString s => s -> Bool
and an Hspec test,
{-# LANGUAGE OverloadedStrings #-}
...
import Data.String (fromString)
spec_p :: Spec
spec_p =
describe "p" $
it "is lazy" $ p (fromString x) `shouldBe` y
where
x = "foo" ++ [undefined]
y = True
that fails if p ("foo" ++ [undefined]) tries to consume any more than "foo".
This works fine for my String implementation,
import qualified Data.List as L
p :: String -> Bool
p = ("foo" `L.isPrefixOf`)
But it does not work so fine on my Data.Text.Lazy implementation,
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
p :: Text -> Bool
p = ("foo" `T.isPrefixOf`)
because fromString does not convert the lazy String into a lazy Text in a way that preserves the undefined unevaluated. I can test that the lazy version does work by writing a specialized test,
pTest :: Bool
pTest = p (T.fromChunks [ "foo", undefined ]) -- True
but I can't control how fromString chunks.
Attempted solution:
I tried to write my own wrapper to control the chunking of fromString,
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
newtype LazyChunkyText = LazyChunkyText LT.Text deriving (Show)
instance IsString LazyChunkyText where
fromString = LazyChunkyText . LT.fromChunks . map (T.pack . return)
But because fromChunks takes a [T.Text], I need to T.pack.
Meaning my [undefined] gets evaluated.

Related

Assign boolean values to variables created from char list

I have two lists:
"ab" and [False,True]
Is it possible to create variables from first list and assign to them booleans from second list?
Something like this:
a = False
b = True
First the technically-yes-but-please-don't-do-this-it's-an-advanced-trick-that-should-only-be-used-if-you're-confident-this-is-really-what-you-want answer:
To generate variables guided by data you need Template Haskell.
{-# LANGUAGE TemplateHaskell #-}
module VariableGenerator where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Control.Monad
generateVariables :: Lift t => [Char] -> [t] -> DecsQ
generateVariables is qs = concat <$> zipWithM (\i q -> [d| $(varP $ mkName [i]) = q |]) is qs
This can then be used in another module like
{-# LANGUAGE TemplateHaskell #-}
import VariableGenerator
generateVariables "ab" [False, True]
main :: IO ()
main = do
print a
print b
Proper answer
I think what you want is simply a map.
Prelude> import qualified Data.Map as Map
Prelude Map> let m = Map.fromList $ zip "ab" [False, True]
Prelude Map> m Map.! 'a'
False
Prelude Map> m Map.! 'b'
True

How can I decode JSON using a custom `parseJSON` - a function rather than the function related to the instance for `fromJSON`?

This function:
eitherDecode :: FromJSON a => ByteString -> Either String a
Has a small limitation that I can't have an additional implementation of a decode that is NOT the one from FromJSON a.
In other words I'm looking for some way to pass my own Bytestring -> Either String a parsing function.
Okay... So I'll have to define my own function for this it seems.
It's defined as:
-- | Like 'decode' but returns an error message when decoding fails.
eitherDecode :: (FromJSON a) => L.ByteString -> Either String a
eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
Looks like ifrom is what I need to modify which is defined as:
-- | Convert a value from JSON, failing if the types do not match.
ifromJSON :: (FromJSON a) => Value -> IResult a
ifromJSON = iparse parseJSON
Well eitherFormatError is not exported from Aeson so this basically seems like I might be going down the wrong approach.
After a bit of type juggling...
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module AesonExtra where
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as HashMap
import Data.Foldable (toList)
import Data.String.Conversions
import Data.Text (Text)
eitherDecodeCustom :: (Value -> Parser a) -> L.ByteString -> Either String a
eitherDecodeCustom f x = do
xx <- eitherDecode x :: Either String Value
parseEither f xx

How to force a list of assertions to be executed in Haskell?

I've generated a list of assertions I'd like to have run.
Here's an interesting case. In the script below, a list of pairs of strings are generated with the entries in the pairs never being equal (namePairs). An assertion should throw an error if one of the strings is a substring of the other string in the pair. I've played around with the script enough to notice that it will throw an error if you encounter foo (which happens when head is used, as shown), or an error will be shown if you replace head with last, but in this case it will occur for bar - the last string in the list). But this only works if I leave off the i =/ j guard, which is not what I want, but helped me to identify the issue. If the guard is left in, then no error is thrown since these cases were the cases where i == j.
I saw How to force evaluation in Haskell?, but despite using the BangPatterns approach described there, I've not been able to get this to work, despite the cargo-cult level of usage.
#!/usr/bin/env stack
{- stack script --nix --resolver lts-14.20
--nix-packages zlib
--no-nix-pure
--package non-empty-text
--package text
--package time
-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Data.Maybe
import Data.List (isSubsequenceOf)
import Data.Text (Text)
import qualified Data.Text as DT
import qualified Data.Text.Lazy as DTL
import qualified Data.Text.IO as DTIO
entryKeys :: [Text]
entryKeys = filter (\t -> DT.length t > 0) $ DT.split (==' ')
"foo DIBBsMain DIBBsContainers DIBBs bar"
main :: IO ()
main = do
putStrLn $ show entryKeys
!_ <- entryNameCheck entryKeys
pure ()
entryNameCheck :: [Text] -> IO ()
entryNameCheck !eNames = do
putStrLn $ show namePairs
!x <- pure $ checkPair <$> namePairs
pure $ head x
where
!lStr = DT.unpack . DT.toLower
!namePairs = [(lStr i, lStr j) | i <- eNames, j <- eNames, i /= j]
errmsg !ns = "!! " <> fst ns <> " is a substring of " <> snd ns
checkPair !p = assertOrErr ((not $ isSubsequenceOf (fst p) (snd p))) (errmsg p)
assertOrErr :: Bool -> String -> ()
assertOrErr !cond !msg = if cond then () else error msg

Template Haskell and Implicit Parameters

Is there a way to create functions with implicit parameters or let bindings with implicit parameters using template haskell?
I.e. is it possible to generate a signature like this using template haskell:
doSomething :: (?context :: Context) => m a
Or an invocation like this:
invoc = let ?context = newContext in doSomething
I could not find suitable algebraic data types nor any functions which would help me out on this topic in the API documentation for template haskell. I'm using GHC 7.4.2.
If there is no native support for this extension in template haskell, is there some other possibility to inject code during compilation (maybe something like a general “code injection function” within template haskell?).
EDIT: I tried the suggestion from the comments, this is what happens:
runQ [d| f :: (?c :: String) => Int ; f = 7 |]
<interactive>:10:17: parse error on input `c'
whereas this works:
runQ [d| f :: Int ; f = 7|]
[SigD f_0 (ConT GHC.Types.Int),ValD (VarP f_0) (NormalB (LitE (IntegerL 7))) []]
doesn't seem to be supported.
Here's one way that's pretty fragile, but sort of works. While you can't refer
to ?x in the Exp that template haskell uses, you can refer to a definition in
another module like:
reserved_prefix_x = ?x
Below is some code that generates variables like above in one run of ghc,
and in a second run of ghc the variables actually refer to implicit parameters.
{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
module GenMod (h) where
import Data.Generics
import Data.IORef
import Data.List
import Language.Haskell.Meta.Parse as P
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import qualified Data.Set as S
import qualified Language.Haskell.Exts.QQ as Q
import System.IO.Unsafe
h = Q.hs { quoteExp = \s -> do
r <- either fail (upVars . return) (P.parseExp s)
writeMod'
return r
}
pfx = "q_"
{-# NOINLINE vars #-}
vars :: IORef (S.Set String)
vars = unsafePerformIO (newIORef S.empty)
writeMod' = runIO $ writeFile "GEN.hs" . ppMod =<< readIORef vars
writeMod = -- might be needed to avoid multiple calls to writeFile?
-- in this example this is called for every use of `h'
QuasiQuoter { quoteDec = \ _ -> do
writeMod'
[d| _ = () |] }
ppMod xs = "{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-}\n\
\module GEN where\n" ++
unlines (map (\x -> pfx ++ x ++ " = ?" ++ x) (S.toList xs))
upVars x = do
x' <- x
runIO $ modifyIORef vars (S.union (getMatchingVars x'))
runIO $ print =<< readIORef vars
return x'
getMatchingVars =
everything
S.union
(mkQ S.empty
(\ (OccName x) -> maybe S.empty S.singleton (stripPrefix pfx x)))
A Main.hs file that uses the quasiquoter GenMod.hs:
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams, QuasiQuotes, TemplateHaskell, CPP #-}
import GenMod
#ifndef stage1
import GEN
#endif
f_ = [h| q_hithere |]
You have to call ghc twice, like:
ghci -Dstage1 Main.hs
GHCi, version 7.6.1: http://www.haskell.org/ghc/ :? for help
[1 of 2] Compiling GenMod ( GenMod.hs, interpreted )
[2 of 2] Compiling Main ( Ex.hs, interpreted )
fromList ["hithere"]
Ex.hs:8:6: Not in scope: `q_hithere'
Failed, modules loaded: GenMod.
Though ghc fails, it still generates the GEN.hs which contains:
{-# LANGUAGE NoMonomorphismRestriction, ImplicitParams #-}
module GEN where
q_hithere = ?hithere
Which will be there when you load Main (leaving out the -D flag)
*Main> :t f_
f_ :: (?hithere::t) => t
This kind of trouble probably isn't worth it. Maybe other situations of calling out to other programs from TH are more motivating such as inline calls to other languages http://hpaste.org/50837 (gfortran example)
Since I used haskell-src-meta's default parser, the quasiquote gets to use variables "reserved_prefix_x" not "?x". It should be possible to accept the "?x" without too much difficulty.

Using Parsec with Data.Text

Using Parsec 3.1, it is possible to parse several types of inputs:
[Char] with Text.Parsec.String
Data.ByteString with Text.Parsec.ByteString
Data.ByteString.Lazy with Text.Parsec.ByteString.Lazy
I don't see anything for the Data.Text module. I want to parse Unicode content without suffering from the String inefficiencies. So I've created the following module based on the Text.Parsec.ByteString module:
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Parsec.Text
( Parser, GenParser
) where
import Text.Parsec.Prim
import qualified Data.Text as T
instance (Monad m) => Stream T.Text m Char where
uncons = return . T.uncons
type Parser = Parsec T.Text ()
type GenParser t st = Parsec T.Text st
Does it make sense to do so?
It this compatible with the rest of the Parsec API?
Additional comments:
I had to add {-# LANGUAGE NoMonomorphismRestriction #-} pragma in my parse modules to make it work.
Parsing Text is one thing, building an AST with Text is another thing. I will also need to pack my String before return:
module TestText where
import Data.Text as T
import Text.Parsec
import Text.Parsec.Prim
import Text.Parsec.Text
input = T.pack "xxxxxxxxxxxxxxyyyyxxxxxxxxxp"
parser = do
x1 <- many1 (char 'x')
y <- many1 (char 'y')
x2 <- many1 (char 'x')
return (T.pack x1, T.pack y, T.pack x2)
test = runParser parser () "test" input
Since Parsec 3.1.2 support of Data.Text is built-in!
See http://hackage.haskell.org/package/parsec-3.1.2
If you are stuck with older version, the code snippets in other answers are helpful, too.
That looks like exactly what you need to do.
It should be compatible with the rest of Parsec, include the Parsec.Char parsers.
If you're using Cabal to build your program, please put an upper bound of parsec-3.1 in your package description, in case the maintainer decides to include that instance in a future version of Parsec.
I added a function parseFromUtf8File to help reading UTF-8 encoded files in an efficient fashion. Works flawlessly with umlaut characters. Function type matches parseFromFile from Text.Parsec.ByteString. This version uses strict ByteStrings.
-- A derivate work from
-- http://stackoverflow.com/questions/4064532/using-parsec-with-data-text
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.Parsec.Text
( Parser, GenParser, parseFromUtf8File
) where
import Text.Parsec.Prim
import qualified Data.Text as T
import qualified Data.ByteString as B
import Data.Text.Encoding
import Text.Parsec.Error
instance (Monad m) => Stream T.Text m Char where
uncons = return . T.uncons
type Parser = Parsec T.Text ()
type GenParser t st = Parsec T.Text st
-- | #parseFromUtf8File p filePath# runs a strict bytestring parser
-- #p# on the input read from #filePath# using
-- 'ByteString.readFile'. Returns either a 'ParseError' ('Left') or a
-- value of type #a# ('Right').
--
-- > main = do{ result <- parseFromFile numbers "digits.txt"
-- > ; case result of
-- > Left err -> print err
-- > Right xs -> print (sum xs)
-- > }
parseFromUtf8File :: Parser a -> String -> IO (Either ParseError a)
parseFromUtf8File p fname = do
raw <- B.readFile fname
let input = decodeUtf8 raw
return (runP p () fname input)

Resources