I've got a situation where I need to compile some Haskell code on different machines.
At least one of these machines has a rather old version of Control.Concurrent.STM, that doesn't know modifyTVar. My current workaround is to copy the code for modifyTVar from a newer version of the package. This got me wondering, if it would be possible to use template Haskell to check if a function is already defined and only define it, if it's missing. I'm aware that the proper solution would probably be to get more recent packages, but the situation got me curious.
It seems to be possible as follows. First a helper module:
{-# LANGUAGE TemplateHaskell #-}
module AddFn where
import Language.Haskell.TH
-- | Add a function if it doesn't exist.
addFn :: String -> Q [Dec] -> Q [Dec]
addFn name decl = do
r <- lookupValueName name
case r of
Just l -> return []
Nothing -> report False ("adding missing " ++ name) >> decl
and use it as in
{-# LANGUAGE TemplateHaskell #-}
module Main where
import AddFn
import qualified Data.Traversable as T
$(addFn "mapM"
[d| mapM :: (Monad m) => (a -> m b) -> [a] -> m [b]
mapM = T.mapM
|])
$(addFn "mapM1"
[d| mapM1 :: (Monad m) => (a -> m b) -> [a] -> m [b]
mapM1 = T.mapM
|])
The drawback is that it's using lookupValueName, which is only in the recent versions of TH, so when dealing with old installations, this probably won't help. Perhaps a possible solution would be to instead call reify on a given name, and use recover to handle the case when the name is missing.
Update: The version using reify instead of lookupValueName works:
-- | Add a function if it doesn't exist.
addFn :: String -> Q [Dec] -> Q [Dec]
addFn name decl = recover decl (reify (mkName name) >> return [])
Template Haskell is somewhat overkill for this - you can use CPP instead, using the MIN_VERSION macros that Cabal will define:
{-# LANGUAGE CPP #-}
#if MIN_VERSION_stm(2, 3, 0)
-- nothing
#else
modifyTVar = ...
#endif
Related
Suppose you're writing some Template Haskell code that transforms record declarations. The first transformation you would want to write is the identity one, right? So let's go over the fields and not change them:
module TH where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
foo :: DecsQ -> DecsQ
foo = fmap $ map $ \d -> case d of
DataD _ dataName tvbs Nothing [con#(RecC conName fields)] [] ->
DataD [] dataName
tvbs
Nothing
[RecC conName $ map transformField fields]
[]
_ -> d
-- TODO: Write my awesome transformation here
transformField :: VarBangType -> VarBangType
transformField (v, b, t) = (v, b, t)
You try it out in a module with a record type:
{-# LANGUAGE TemplateHaskell #-}
import TH
foo [d| data R = MkR{ x :: Int } |]
So far so good. However, things break if we turn on DuplicateRecordFields in our program, even though we haven't written transformField yet (i.e. it is still the identity function):
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
import TH
foo [d| data R = MkR{ x :: Int } |]
This program now fails to compile, with the following message:
Use.hs:5:1: error:
Illegal variable name: $sel:x:MkR
When splicing a TH declaration:
data R_0 = MkR_1 {$sel:x:MkR_2 :: GHC.Types.Int}
Even this super-minimal program fails with a similar error:
{-# LANGUAGE DuplicateRecordFields, TemplateHaskell #-}
$([d| data R = MkR{ x :: Int } |])
There's not much mystery why this happens: as the DuplicateRecordFields documentation explains, field selectors are mangled to be unique accross all record types, and TH gets these mangled field names.
But how to solve this is not explained on that same page. For now, I am using the following function to unmangle a mangled field name into something that roundtrips accross data declaration splices:
import Data.List.Split
unmangle :: Name -> Name
unmangle (Name occ flavour) = Name occ' flavour
where
occ' = case wordsBy (== ':') (occString occ) of
["$sel", fd, _qual] -> mkOccName fd
_ -> occ
transformField :: VarBangType -> VarBangType
transformField (v, b, t) = (unmangle v, b, t)
This works, but doesn't feel like the right solution, and probably won't survive changes to GHC-internal details of name mangling. Is there a better way to do this?
I was looking at the penultimate example in this blog post (also here), and after verifying it ran, it seemed to confirm that lens can generate Has typeclasses, which I take was the implication from the author of the blog. However, I miss where this is described, either in the lens contents or the lens tutorial. Any explanations external to official docs for how this is done would also be welcome. But it seems like this may just be standard when using the most basic feature (makeLenses, or in this case, makeLensesWith).
Here is the reproduced code:
#!/usr/bin/env stack
-- stack --resolver lts-8.12 script
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
import Control.Concurrent.Async.Lifted.Safe
import Control.Monad.Reader
import Control.Concurrent.STM
import Say
import Control.Lens
import Prelude hiding (log)
data Env = Env
{ envLog :: !(String -> IO ())
, envBalance :: !(TVar Int)
}
makeLensesWith camelCaseFields ''Env
modify :: (MonadReader env m, HasBalance env (TVar Int), MonadIO m)
=> (Int -> Int)
-> m ()
modify f = do
env <- ask
liftIO $ atomically $ modifyTVar' (env^.balance) f
logSomething :: (MonadReader env m, HasLog env (String -> IO ()), MonadIO m)
=> String
-> m ()
logSomething msg = do
env <- ask
liftIO $ (env^.log) msg
main :: IO ()
main = do
ref <- newTVarIO 4
let env = Env
{ envLog = sayString
, envBalance = ref
}
runReaderT
(concurrently
(modify (+ 1))
(logSomething "Increasing account balance"))
env
balance <- readTVarIO ref
sayString $ "Final balance: " ++ show balance
Field is the word lens uses to describe the pattern of one class per named field, allowing multiple records with the same field name but (optionally) different types. So camelCaseFields, makeFieldOptics, defaultFieldRules all say in their name that they will generate these HasFoo classes, in the usual terse style of lens.
makeClassy also generates classes named Has*, but named after the data type, not the record field, and not following a different pattern.
Your code above generates the following code (shown with -ddump-splices):
makeLensesWith camelCaseFields ''Env
======>
class HasBalance s a | s -> a where
balance :: Lens' s a
instance HasBalance Env (TVar Int) where
{-# INLINE balance #-}
balance f_a4eTr (Env x1_a4eTs x2_a4eTt)
= (fmap (\ y1_a4eTu -> (Env x1_a4eTs) y1_a4eTu)) (f_a4eTr x2_a4eTt)
class HasLog s a | s -> a where
log :: Lens' s a
instance HasLog Env (String -> IO ()) where
{-# INLINE log #-}
log f_a4eTx (Env x1_a4eTy x2_a4eTz)
= (fmap (\ y1_a4eTA -> (Env y1_a4eTA) x2_a4eTz)) (f_a4eTx x1_a4eTy)
I'm looking for a function that does what the GHCi :type command does.
Ideally, it would have a signature something like
getStaticType :: a -> String
a = getStaticType (1+2)
-- a = "(Num t) => t"
b = getStaticType zipWith
-- b = "(a -> b -> c) -> [a] -> [b] -> [c]"
(Note: this has nothing to do with Data.Dynamic. I just want the static type inferred from the compiler. In fact the function wouldn't need a runtime implementation at all, as all calls to it could be inlined as constants at compile time. I'm assuming it exists somewhere, since GHCi can do it)
You can do it like this:
import Data.Typeable
getStaticType :: Typeable a => a -> String
getStaticType = show . typeOf
Note that the type must be an instance of Typeable. You can derive Typeable automatically using the DeriveDataTypeable Haskell language extension and ... deriving (Typeable, ...).
Also note that polymorphic types cannot be identified in this way; you must always call a function with a specific type, so you can never get that polymorphic type information that you get in GHCi with compiled Haskell code.
The way GHCi does it is that it uses the GHC API to analyse an intermediary Haskell abstract syntax tree (AST) that contains type information. GHCi does not have the same restricted environment that your typical compiled Haskell program does; it can do lots of stuff to find out more information about its environment.
With TemplateHaskell, you can do it like this; first, create this module:
module TypeOf where
import Control.Monad
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
getStaticType :: Name -> Q Exp
getStaticType = lift <=< fmap pprint . reify
Then, in a different module (very important), you can do the following:
{-# LANGUAGE TemplateHaskell #-}
import TypeOf
main = putStrLn $(getStaticType 'zipWith)
This program outputs:
GHC.List.zipWith :: forall a_0 b_1 c_2 . (a_0 -> b_1 -> c_2) ->
[a_0] -> [b_1] -> [c_2]
You can use a better pretty-printer than the pprint function; take a look at the Language.Haskell.TH.Ppr module.
try http://www.haskell.org/haskellwiki/GHC/As_a_library
typed targetFile targetModule = do
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
let dflags' = xopt_set dflags Opt_ImplicitPrelude
setSessionDynFlags dflags'
target <- guessTarget targetFile Nothing
setTargets [target]
load LoadAllTargets
m <- getModSummary $ mkModuleName targetModule
p <- parseModule m
t <- typecheckModule p
return $ typecheckedSource d
Quasiquotation as described in haskellwiki is shown mostly as useful tool for embedding other languages inside Haskell without messing around with string quotation.
Question is: For Haskell itself, how easy it would be to put existing Haskell code through a quasiquoter for the purpose of just replacing tokens and passing the result over to ghc? Perhaps Template Haskell is key here?
I have looked for code examples and didn't find any. Some EDSLs can benefit from this ability by reducing the size of their combinating operators (e.g. turn 'a .|. b .>>. c' to '[myedsl|a | b >> c]').
You can build quasi-quoters that manipulate Haskell code by, for example, using the haskell-src-meta package. It parses valid Haskell code into an AST, which you can then modify.
In this case, the easiest way to modify the AST is by using Data.Generics to apply a generic transformation to the whole AST that replaces operators with other operators.
We'll begin by building the transformation function for generic Haskell expressions. The data type that represents an expression is Exp in the template-haskell package.
For example, to convert the operator >> to .>>. we'd use a function like
import Language.Haskell.TH (Exp(..), mkName)
replaceOp :: Exp -> Exp
replaceOp (VarE n) | n == mkName ">>" = VarE (mkName ".>>.")
replaceOp e = e
This changes a variable expression (VarE), but cannot do anything to any other kind of expressions.
Now, to walk the whole AST and to replace all occurrences of >> we'll use the functions everywhere and mkT from Data.Generic.
import Data.Generics (everywhere, mkT)
replaceEveryOp :: Exp -> Exp
replaceEveryOp = everywhere (mkT replaceOp)
In order to make several replacements, we can alter the function so that it takes an association list of any operator to replace.
type Replacements = [(String, String)]
replaceOps :: Replacements -> Exp -> Exp
replaceOps reps = everywhere (mkT f) where
f e#(VarE n) = case rep of
Just n' -> VarE (mkName n')
_ -> e
where rep = lookup (show n) reps
f e = e
And by the way, this is a good example of a function that is much nicer to write by using the view patterns language extension.
{-# LANGUAGE ViewPatterns #-}
replaceOps :: Replacements -> Exp -> Exp
replaceOps reps = everywhere (mkT f) where
f (VarE (replace -> Just n')) = VarE (mkName n')
f e = e
replace n = lookup (show n) reps
Now all that's left for us to do is to build the "myedsl" quasi-quoter.
{-# LANGUAGE ViewPatterns #-}
import Data.Generics (everywhere, mkT)
import Language.Haskell.Meta.Parse (parseExp)
import Language.Haskell.TH (Exp(..), mkName, ExpQ)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
type Replacements = [(String, String)]
replacements :: Replacements
replacements =
[ ("||", ".|.")
, (">>", ".>>.")
]
myedls = QuasiQuoter
{ quoteExp = replaceOpsQ
, quotePat = undefined
, quoteType = undefined
, quoteDec = undefined
}
replaceOpsQ :: String -> ExpQ
replaceOpsQ s = case parseExp s of
Right e -> return $ replaceOps replacements e
Left err -> fail err
replaceOps :: Replacements -> Exp -> Exp
replaceOps reps = everywhere (mkT f) where
f (VarE (replace -> Just n')) = VarE (mkName n')
f e = e
replace n = lookup (show n) reps
If you save the above to its own module (e.g. MyEDSL.hs), then you can import it and use the quasi-quoter.
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
import MyEDSL
foo = [myedsl| a || b >> c |]
Note that I've used || instead of | because the latter is not a valid operator in Haskell (since it's the syntactic element used for pattern guards).
I'm looking for a function that does what the GHCi :type command does.
Ideally, it would have a signature something like
getStaticType :: a -> String
a = getStaticType (1+2)
-- a = "(Num t) => t"
b = getStaticType zipWith
-- b = "(a -> b -> c) -> [a] -> [b] -> [c]"
(Note: this has nothing to do with Data.Dynamic. I just want the static type inferred from the compiler. In fact the function wouldn't need a runtime implementation at all, as all calls to it could be inlined as constants at compile time. I'm assuming it exists somewhere, since GHCi can do it)
You can do it like this:
import Data.Typeable
getStaticType :: Typeable a => a -> String
getStaticType = show . typeOf
Note that the type must be an instance of Typeable. You can derive Typeable automatically using the DeriveDataTypeable Haskell language extension and ... deriving (Typeable, ...).
Also note that polymorphic types cannot be identified in this way; you must always call a function with a specific type, so you can never get that polymorphic type information that you get in GHCi with compiled Haskell code.
The way GHCi does it is that it uses the GHC API to analyse an intermediary Haskell abstract syntax tree (AST) that contains type information. GHCi does not have the same restricted environment that your typical compiled Haskell program does; it can do lots of stuff to find out more information about its environment.
With TemplateHaskell, you can do it like this; first, create this module:
module TypeOf where
import Control.Monad
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
getStaticType :: Name -> Q Exp
getStaticType = lift <=< fmap pprint . reify
Then, in a different module (very important), you can do the following:
{-# LANGUAGE TemplateHaskell #-}
import TypeOf
main = putStrLn $(getStaticType 'zipWith)
This program outputs:
GHC.List.zipWith :: forall a_0 b_1 c_2 . (a_0 -> b_1 -> c_2) ->
[a_0] -> [b_1] -> [c_2]
You can use a better pretty-printer than the pprint function; take a look at the Language.Haskell.TH.Ppr module.
try http://www.haskell.org/haskellwiki/GHC/As_a_library
typed targetFile targetModule = do
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
let dflags' = xopt_set dflags Opt_ImplicitPrelude
setSessionDynFlags dflags'
target <- guessTarget targetFile Nothing
setTargets [target]
load LoadAllTargets
m <- getModSummary $ mkModuleName targetModule
p <- parseModule m
t <- typecheckModule p
return $ typecheckedSource d