{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Haskell.Template where

import BNFC.CF

import BNFC.Backend.CommonInterface.Backend

import BNFC.Backend.Common.Utils as Utils

import BNFC.Backend.Haskell.Options
import BNFC.Backend.Haskell.State

import BNFC.Backend.Haskell.Utilities.Utils

import BNFC.Options.GlobalOptions

import BNFC.Prelude

import Control.Monad.State

import qualified Data.Map     as Map
import           Data.List   (intersperse)
import           Data.String (fromString)

import Prettyprinter

import System.FilePath (takeBaseName)

haskellTemplate :: LBNF -> State HaskellBackendState Result
haskellTemplate :: LBNF -> State HaskellBackendState Result
haskellTemplate LBNF
lbnf = do
  HaskellBackendState
st <- StateT HaskellBackendState Identity HaskellBackendState
forall s (m :: * -> *). MonadState s m => m s
get
  let
    cfName :: String
cfName      = String -> String
takeBaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ GlobalOptions -> String
optInput (GlobalOptions -> String) -> GlobalOptions -> String
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> GlobalOptions
globalOpt HaskellBackendState
st
    rules :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
rules       = [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
filterRules ([(Type, [(Label, ([Type], (Integer, ARHS)))])]
 -> [(Type, [(Label, ([Type], (Integer, ARHS)))])])
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
forall a b. (a -> b) -> a -> b
$ HaskellBackendState
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules HaskellBackendState
st
    tokensNames :: [CatName]
tokensNames = (CatName, TokenDef) -> CatName
forall a b. (a, b) -> a
fst ((CatName, TokenDef) -> CatName)
-> [(CatName, TokenDef)] -> [CatName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HaskellBackendState -> [(CatName, TokenDef)]
tokens HaskellBackendState
st
    inDirectory :: Bool
inDirectory = HaskellBackendOptions -> Bool
inDir (HaskellBackendOptions -> Bool) -> HaskellBackendOptions -> Bool
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> HaskellBackendOptions
haskellOpts HaskellBackendState
st
    nSpace :: Maybe String
nSpace      = HaskellBackendOptions -> Maybe String
nameSpace (HaskellBackendOptions -> Maybe String)
-> HaskellBackendOptions -> Maybe String
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> HaskellBackendOptions
haskellOpts HaskellBackendState
st
    funct :: Bool
funct       = HaskellBackendOptions -> Bool
functor (HaskellBackendOptions -> Bool) -> HaskellBackendOptions -> Bool
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> HaskellBackendOptions
haskellOpts HaskellBackendState
st
    template :: String
template    = [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [CatName] -> String -> Bool -> Maybe String -> Bool -> String
cf2template [(Type, [(Label, ([Type], (Integer, ARHS)))])]
rules [CatName]
tokensNames String
cfName Bool
inDirectory Maybe String
nSpace Bool
funct
  Result -> State HaskellBackendState Result
forall (m :: * -> *) a. Monad m => a -> m a
return [(Bool -> Maybe String -> String -> String -> String -> String
mkFilePath Bool
inDirectory Maybe String
nSpace String
cfName String
"Skel" String
"hs", String
template)]

  where

      filterRules :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
                  -> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
      filterRules :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
filterRules [(Type, [(Label, ([Type], (Integer, ARHS)))])]
rules =
        ((Type, [(Label, ([Type], (Integer, ARHS)))]) -> Bool)
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
forall a. (a -> Bool) -> [a] -> [a]
filter
        (\(Type
_,[(Label, ([Type], (Integer, ARHS)))]
l) -> Bool -> Bool
not ([(Label, ([Type], (Integer, ARHS)))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Label, ([Type], (Integer, ARHS)))]
l))
        ((\(Type
f,[(Label, ([Type], (Integer, ARHS)))]
s) -> (Type
f, [String]
-> [(Label, ([Type], (Integer, ARHS)))]
-> [(Label, ([Type], (Integer, ARHS)))]
filterLabelsAST [String]
fNames [(Label, ([Type], (Integer, ARHS)))]
s)) ((Type, [(Label, ([Type], (Integer, ARHS)))])
 -> (Type, [(Label, ([Type], (Integer, ARHS)))]))
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
rules)

      -- Functions names.
      fNames :: [String]
      fNames :: [String]
fNames = CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (CatName -> String) -> [CatName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CatName (WithPosition Function) -> [CatName]
forall k a. Map k a -> [k]
Map.keys (LBNF -> Map CatName (WithPosition Function)
_lbnfFunctions LBNF
lbnf)

cf2template :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
            -> [CatName]
            -> String
            -> Bool
            -> Maybe String
            -> Bool
            -> String
cf2template :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [CatName] -> String -> Bool -> Maybe String -> Bool -> String
cf2template [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules [CatName]
tokens String
cfName Bool
inDir Maybe String
nameSpace Bool
functor =
  LayoutOptions -> Doc () -> String
docToString LayoutOptions
defaultLayoutOptions (Doc () -> String) -> Doc () -> String
forall a b. (a -> b) -> a -> b
$ [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [CatName] -> String -> Bool -> Maybe String -> Bool -> Doc ()
cf2doc [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules [CatName]
tokens String
cfName Bool
inDir Maybe String
nameSpace Bool
functor

cf2doc :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
       -> [CatName]
       -> String
       -> Bool
       -> Maybe String
       -> Bool
       -> Doc ()
cf2doc :: [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [CatName] -> String -> Bool -> Maybe String -> Bool -> Doc ()
cf2doc [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules [CatName]
tokens String
cfName Bool
inDir Maybe String
nameSpace Bool
functor = ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ())
-> ([Doc ()] -> [Doc ()]) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
intersperse Doc ()
forall ann. Doc ann
emptyDoc) ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$
  String -> String -> Bool -> Bool -> Doc ()
prologue String
modName String
absName Bool
emptyTree Bool
hasData Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
: [Doc ()]
toBePrinted

  where

    hasData :: Bool
hasData        = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Type, [(Label, ([Type], (Integer, ARHS)))])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules
    hasTokens :: Bool
hasTokens      = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [CatName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CatName]
tokens

    emptyTree :: Bool
emptyTree      = Bool -> Bool
not (Bool
hasData Bool -> Bool -> Bool
|| Bool
hasTokens)

    datas :: Maybe (Doc ())
datas =
      if [(Type, [(Label, ([Type], (Integer, ARHS)))])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules
      then Maybe (Doc ())
forall a. Maybe a
Nothing
      else Doc () -> Maybe (Doc ())
forall a. a -> Maybe a
Just (Doc () -> Maybe (Doc ())) -> Doc () -> Maybe (Doc ())
forall a b. (a -> b) -> a -> b
$ String
-> Bool -> [(Type, [(Label, ([Type], (Integer, ARHS)))])] -> Doc ()
printDatas String
absName Bool
functor [(Type, [(Label, ([Type], (Integer, ARHS)))])]
astRules

    toks :: Maybe (Doc ())
toks =
      if [CatName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CatName]
tokens
      then Maybe (Doc ())
forall a. Maybe a
Nothing
      else Doc () -> Maybe (Doc ())
forall a. a -> Maybe a
Just (Doc () -> Maybe (Doc ())) -> Doc () -> Maybe (Doc ())
forall a b. (a -> b) -> a -> b
$ String -> [CatName] -> Doc ()
printTokens String
absName [CatName]
tokens

    toBePrinted :: [Doc ()]
toBePrinted = [Maybe (Doc ())] -> [Doc ()]
forall a. [Maybe a] -> [a]
catMaybes [ Maybe (Doc ())
toks, Maybe (Doc ())
datas]

    modName :: ModuleName
    modName :: String
modName = Bool -> Maybe String -> String -> String -> String
mkModule Bool
inDir Maybe String
nameSpace String
cfName String
"Skel"
    absName :: ModuleName
    absName :: String
absName = Bool -> Maybe String -> String -> String -> String
mkModule Bool
inDir Maybe String
nameSpace String
cfName String
"Abs"

prologue :: ModuleName -> ModuleName -> Bool -> Bool -> Doc ()
prologue :: String -> String -> Bool -> Bool -> Doc ()
prologue String
modName String
absName Bool
emptyTree Bool
hasData = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$
  [ Doc ()
"-- File generated by the BNF Converter."
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- Templates for pattern matching on abstract syntax"
  , Doc ()
forall ann. Doc ann
emptyDoc
  ]
  [Doc ()] -> [Doc ()] -> [Doc ()]
forall a. [a] -> [a] -> [a]
++
  Bool -> [Doc ()] -> [Doc ()]
forall m. Monoid m => Bool -> m -> m
Utils.when Bool
emptyTree [ Doc ()
"{-# LANGUAGE EmptyCase #-}", Doc ()
forall ann. Doc ann
emptyDoc ]
  [Doc ()] -> [Doc ()] -> [Doc ()]
forall a. [a] -> [a] -> [a]
++
  [ Doc ()
"{-# OPTIONS_GHC -fno-warn-unused-matches #-}"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"module" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
modName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"where"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"import Prelude (($), Either(..), String, (++), Show, show)"
  , Doc ()
forall ann. Doc ann
emptyDoc
  ]
  [Doc ()] -> [Doc ()] -> [Doc ()]
forall a. [a] -> [a] -> [a]
++
  Bool -> [Doc ()] -> [Doc ()]
forall m. Monoid m => Bool -> m -> m
Utils.when Bool
hasData
    [ Doc ()
"import qualified" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName
    , Doc ()
forall ann. Doc ann
emptyDoc
    ]
  [Doc ()] -> [Doc ()] -> [Doc ()]
forall a. [a] -> [a] -> [a]
++
  [ Doc ()
"type Err = Either String"
  , Doc ()
"type Result = Err String"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"failure :: Show a => a -> Result"
  , Doc ()
"failure x = Left $ \"Undefined case: \" ++ show x"
  ]

printTokens :: ModuleName -> [CatName] -> Doc ()
printTokens :: String -> [CatName] -> Doc ()
printTokens String
absName =
  [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ())
-> ([CatName] -> [Doc ()]) -> [CatName] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
intersperse Doc ()
forall ann. Doc ann
emptyDoc ([Doc ()] -> [Doc ()])
-> ([CatName] -> [Doc ()]) -> [CatName] -> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (CatName -> Doc ()) -> [CatName] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> CatName -> Doc ()
printToken String
absName)

printToken :: ModuleName -> CatName -> Doc ()
printToken :: String -> CatName -> Doc ()
printToken String
absName CatName
catName = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
  [ Doc ()
"trans" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tokenName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"::" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tokenName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    Doc ()
"-> Result"
  , Doc ()
"trans" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tokenName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"x = case x of"
  , Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tokenName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"string" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"-> failure x"
  ]
  where
    tokenName :: Doc ()
    tokenName :: Doc ()
tokenName = (String -> Doc ()
forall a. IsString a => String -> a
fromString (String -> Doc ()) -> (CatName -> String) -> CatName -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatName -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) CatName
catName

printDatas :: ModuleName
           -> Bool
           -> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
           -> Doc ()
printDatas :: String
-> Bool -> [(Type, [(Label, ([Type], (Integer, ARHS)))])] -> Doc ()
printDatas String
absName Bool
functor =
  [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ())
-> ([(Type, [(Label, ([Type], (Integer, ARHS)))])] -> [Doc ()])
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
intersperse Doc ()
forall ann. Doc ann
emptyDoc ([Doc ()] -> [Doc ()])
-> ([(Type, [(Label, ([Type], (Integer, ARHS)))])] -> [Doc ()])
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])]
-> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((Type, [(Label, ([Type], (Integer, ARHS)))]) -> Doc ())
-> [(Type, [(Label, ([Type], (Integer, ARHS)))])] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Type -> [(Label, ([Type], (Integer, ARHS)))] -> Doc ())
-> (Type, [(Label, ([Type], (Integer, ARHS)))]) -> Doc ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String
-> Bool -> Type -> [(Label, ([Type], (Integer, ARHS)))] -> Doc ()
printData String
absName Bool
functor))

printData :: ModuleName
          -> Bool
          -> Type
          -> [(Label, ([Type], (Integer, ARHS)))]
          -> Doc ()
printData :: String
-> Bool -> Type -> [(Label, ([Type], (Integer, ARHS)))] -> Doc ()
printData String
absName Bool
functor Type
t [(Label, ([Type], (Integer, ARHS)))]
labelsRhs = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
  [ Doc ()
"trans" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"::" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    if Bool
functor
    then Doc ()
"Show a =>" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"' a" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"-> Result"
    else String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"-> Result"
  , Doc ()
"trans" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
tName Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"x = case x of"
  , Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$ [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep (String -> Bool -> (Label, ARHS) -> Doc ()
printCase String
absName Bool
functor ((Label, ARHS) -> Doc ()) -> [(Label, ARHS)] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Label, ARHS)]
labelsArhss)
  ]
  where
    tName :: Doc ()
    tName :: Doc ()
tName = String -> Doc ()
forall a. IsString a => String -> a
fromString (String -> Doc ()) -> String -> Doc ()
forall a b. (a -> b) -> a -> b
$ Type -> String
printTypeName Type
t

    labelsArhss :: [(Label, ARHS)]
    labelsArhss :: [(Label, ARHS)]
labelsArhss = (\(Label
l,([Type]
_,(Integer, ARHS)
tup)) -> (Label
l, (Integer, ARHS) -> ARHS
forall a b. (a, b) -> b
snd (Integer, ARHS)
tup)) ((Label, ([Type], (Integer, ARHS))) -> (Label, ARHS))
-> [(Label, ([Type], (Integer, ARHS)))] -> [(Label, ARHS)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Label, ([Type], (Integer, ARHS)))]
labelsRhs

printCase :: ModuleName -> Bool -> (Label, ARHS) -> Doc ()
printCase :: String -> Bool -> (Label, ARHS) -> Doc ()
printCase String
absName Bool
functor (Label
l, ARHS
arhs) =
  if Bool
functor
  then [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep
    [ String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall a. IsString a => String -> a
fromString (Label -> String
printLabelName Label
l) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"_" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      if [Doc ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc ()]
args then Doc ()
"-> failure x" else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep [Doc ()]
args Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"-> failure x"
    ]
  else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep
    [ String -> Doc ()
forall a. IsString a => String -> a
fromString String
absName Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
dot Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall a. IsString a => String -> a
fromString (Label -> String
printLabelName Label
l) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
      if [Doc ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc ()]
args then Doc ()
"-> failure x" else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep [Doc ()]
args Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"-> failure x"
    ]
  where
    args :: [Doc ()]
    args :: [Doc ()]
args = ARHS -> [Doc ()]
printArgs ARHS
arhs