Binds.hs

-- | Generation of binding-level AST fragments for refactorings.
-- The bindings defined here create a the annotated version of the AST constructor with the same name.
-- For example, @mkMatch@ creates the annotated version of the @Match@ constructor.
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Tools.AST.Gen.Binds where

import qualified Name as GHC
import Data.List
import Data.String
import Data.Function (on)
import Control.Reference
import Language.Haskell.Tools.AST
import Language.Haskell.Tools.AST.Gen.Utils
import Language.Haskell.Tools.AST.Gen.Base
import Language.Haskell.Tools.AnnTrf.SourceTemplate
import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers

mkSimpleBind :: TemplateAnnot a => Ann Pattern a -> Ann Rhs a -> Maybe (Ann LocalBinds a) -> Ann ValueBind a
mkSimpleBind p r l = mkAnn (child <> child <> child) (SimpleBind p r (mkAnnMaybe (optBefore " ") l))

mkFunctionBind :: TemplateAnnot a => [Ann Match a] -> Ann ValueBind a
mkFunctionBind = mkAnn child . FunBind . mkAnnList indentedList

mkUnguardedRhs :: TemplateAnnot a => Ann Expr a -> Ann Rhs a
mkUnguardedRhs = mkAnn (" = " <> child) . UnguardedRhs

mkMatch :: TemplateAnnot a => Ann MatchLhs a -> Ann Rhs a -> Maybe (Ann LocalBinds a) -> Ann Match a
mkMatch lhs rhs locs 
  = mkAnn (child <> child <> child) 
      $ Match lhs rhs (mkAnnMaybe (optBefore " ") locs)

mkNormalMatchLhs :: TemplateAnnot a => Ann Name a -> [Ann Pattern a] -> Ann MatchLhs a
mkNormalMatchLhs n pats = mkAnn (child <> child) $ NormalLhs n (mkAnnList (listSepBefore " " " ") pats)

mkLocalValBind :: TemplateAnnot a => Ann ValueBind a -> Ann LocalBind a
mkLocalValBind = mkAnn child . LocalValBind

mkLocalBinds :: TemplateAnnot a => Int -> [Ann LocalBind a] -> AnnMaybe LocalBinds a
mkLocalBinds col = mkAnnMaybe (optBefore ("\n" ++ replicate (col - 1) ' ' ++ "where ")) 
                     . Just . mkAnn child . LocalBinds . mkAnnList indentedList