Assign boolean values to variables created from char list - haskell

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

Related

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

How to generate imports and boilerplate lists using Template Haskell?

I'd like to replace this boilerplate with code generation:
import qualified Y15.D01
import qualified Y15.D02
import qualified Y15.D03
import qualified Y15.D04
import qualified Y15.D05
import qualified Y15.D06HM
import qualified Y15.D06IO
import qualified Y15.D06ST
import qualified Y15.D07
import qualified Y15.D08
import qualified Y15.D09
import qualified Y15.D10
import qualified Y15.D11
import qualified Y15.D12
import qualified Y15.D13
...
days :: [(String, [String -> IO String])]
days =
[ ("Y15.D01", i2ios [Y15.D01.solve1, Y15.D01.solve2])
, ("Y15.D02", i2ios [Y15.D02.solve1, Y15.D02.solve2])
, ("Y15.D03", i2ios [Y15.D03.solve1, Y15.D03.solve2])
, ("Y15.D04", i2ios [Y15.D04.solve1, Y15.D04.solve2])
, ("Y15.D05", i2ios [Y15.D05.solve1, Y15.D05.solve2])
, ("Y15.D06HM",i2ios [Y15.D06HM.solve1, Y15.D06HM.solve2]) -- Data.Map.Strict
, ("Y15.D06IO",ioi2ios [Y15.D06IO.solve1, Y15.D06IO.solve2]) -- Data.Array.IO
, ("Y15.D06ST",i2ios [Y15.D06ST.solve1, Y15.D06ST.solve2]) -- Data.Array.ST
, ("Y15.D07", i2ios [Y15.D07.solve1, Y15.D07.solve2])
, ("Y15.D08", i2ios [Y15.D08.solve1, Y15.D08.solve2])
, ("Y15.D09", i2ios [Y15.D09.solve1, Y15.D09.solve2])
, ("Y15.D10", i2ios [Y15.D10.solve1, Y15.D10.solve2])
, ("Y15.D11", s2ios [Y15.D11.solve1, Y15.D11.solve2])
, ("Y15.D12", i2ios [Y15.D12.solve1, Y15.D12.solve2])
, ("Y15.D13", i2ios [Y15.D13.solve1, Y15.D13.solve2])
]
where s2ios :: [a -> b] -> [a -> IO b]
s2ios = fmap (return .)
i2ios :: [a -> Int] -> [a -> IO String]
i2ios = fmap ((return . show) .)
ioi2ios :: [a -> IO Int] -> [a -> IO String]
ioi2ios = fmap (fmap show .)
https://github.com/oshyshko/adventofcode/blob/master/src/Main.hs
I am new to Template Haskell and I would appreciate any help/suggestions on where to start with these questions:
How to list modules in a project that match /Y\d\d.D\d\d.*/ pattern?
How to generate imports for p.1?
How to retrieve types of solve1 and solve2 fns from a given module?
How to generate days list?
With respect to question (2), Template Haskell cannot generate import statements. You can see a very old feature request for it in the bug tracker on GitLab but no one's been sufficiently inspired to implement it.
With respect to question (3), if modules have been imported and their names are available as strings, you can use TH to retrieve the type of a binding in each module like so. Given:
-- M001.hs
module M001 where
solve1 :: Int
solve1 = 10
-- M002.hs
module M002 where
solve1 :: IO Int
solve1 = return 20
-- THTest1.hs
{-# LANGUAGE TemplateHaskell #-}
module THTest1 where
import M001
import M002
import Language.Haskell.TH
let
modules = ["M001", "M002"]
showType :: String -> Q ()
showType nm = do
Just n <- lookupValueName nm
VarI _ typ _ <- reify n
reportWarning $ show nm ++ " has type " ++ show typ
return ()
in do mapM_ showType (map (++ ".solve1") modules)
return []
Then compiling THTest.hs will generate two warnings:
warning: "M001.solve1" has type ConT GHC.Types.Int
warning: "M002.solve1" has type AppT (ConT GHC.Types.IO)
(ConT GHC.Types.Int)
For question (4), here's a simplified example using modules M001 and M002 as defined above. Compile this program with ghc -ddump-splices to see the definition generated for days:
-- THTest2.hs
{-# LANGUAGE TemplateHaskell #-}
import M001
import M002
import Control.Monad
import GHC.Types
import Language.Haskell.TH
let
-- list of modules to search
modules = ["M001", "M002"]
-- assoc list of adapter function by argument type
funcs = [(ConT ''Int, 'return), (AppT (ConT ''IO) (ConT ''Int), 'id)]
getDay :: String -> Q Exp
getDay modname = do
-- look up name (e.g., M001.solve1)
Just n <- lookupValueName (modname ++ ".solve1")
-- get type of binding
VarI _ typ _ <- reify n
-- look up appropriate adapter function
let Just f = lookup typ funcs
-- ("M001", adapter_f M001.solve1)
[|($(pure $ LitE (StringL modname)),
$(pure $ AppE (VarE f) (VarE n)))|]
makeDays :: Q [Dec]
makeDays = do
[d| days :: [(String, IO Int)]
days = $(ListE <$> mapM getDay modules)
|]
in makeDays
main = do
forM days $ \(modname, action) -> do
putStr modname
putStr ": "
print =<< action
Then running it will output:
M001: 10
M002: 20

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

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.

C-style enum in Haskell?

In C, we define enum this way:
enum E {
E0,
E1,
E2 = 3,
E3
};
Note E2 = 3 expression, the enum type result in E0 == 0, E1 == 1, E2 == 3, E3 == 4.
In Haskell, we have no way to specify the enumeration in the declaration. The only way to implement discontinuous enumeration is implementing Enum class manually.
Is there any convenient way to do this?
I've write a demo using Template Haskell to generate the Enum instance.
data E = E0
| E1
| E2_3
| E3
deriving Show
enum ''E
I wonder if there are libraries trying to fill this gap?
You can whip up something small & simple using Template Haskell's reifyAnnotations feature.
First, we need to define an annotation type to hold enum values:
{-# LANGUAGE DeriveDataTypeable #-}
module Def where
import Data.Data
data EnumValue = EnumValue Int deriving (Typeable, Data)
Second, we need a bit of TH code to consume these annotations and turn them into Enum instance definitions:
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
module TH where
import Def
import Language.Haskell.TH.Syntax
import Language.Haskell.TH
import Control.Monad
import Data.List (mapAccumL)
import Data.Maybe
enumValues :: [(a, Maybe Int)] -> [(a, Int)]
enumValues = snd . mapAccumL (\next (x, mv) -> let v = fromMaybe next mv in (v+1, (x, v))) 0
enumFromAnns :: Name -> Q [Dec]
enumFromAnns name = do
TyConI (DataD _ _ _ cons _) <- reify name
eVals <- fmap enumValues $ forM cons $ \(NormalC conName []) -> do
anns <- reifyAnnotations (AnnLookupName conName)
let ev = case anns of
[EnumValue ev] -> Just ev
[] -> Nothing
return (conName, ev)
[d|
instance Enum $(conT name) where
fromEnum = $(lamCaseE [match (conP c []) (normalB $ lift v) [] | (c, v) <- eVals])
toEnum = $(lamCaseE [match (litP . IntegerL . fromIntegral $ v) (normalB $ conE c) [] | (c, v) <- eVals])|]
And then finally we can use it (via a small workaround to make sure the usage is in a new declaration group):
{-# LANGUAGE TemplateHaskell #-}
module AnnotatedEnumExample where
import Def
import TH
data E = E1
| E2
| E42
| E43
deriving Show
{-# ANN E1 (EnumValue 1) #-}
{-# ANN E42 (EnumValue 42) #-}
-- Force new declaration group
return []
enumFromAnns ''E
Example usage:
*AnnotatedEnumExample> map fromEnum [E1, E2, E42, E43]
[1,2,42,43]
*AnnotatedEnumExample> map toEnum [1, 2, 42, 43] :: [E]
[E1,E2,E42,E43]

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.

Resources