module Build.Drasil.Make.Print where
import Prelude hiding ((<>))
import Text.PrettyPrint (Doc, empty, text, (<>), (<+>), ($+$), ($$), hsep, vcat)
import qualified Data.Text as T
import Text.Wrap
import Build.Drasil.Make.AST (Annotation, Command(C),
CommandOpts(IgnoreReturnCode), Dependencies, Makefile(M), Rule(R), Target,
Type(Abstract))
import Build.Drasil.Make.Helpers (addCommonFeatures, tab)
import Build.Drasil.Make.Import (RuleTransformer, toMake)
import Build.Drasil.Make.MakeString (renderMS)
import CodeLang.Drasil (Comment)
genMake :: RuleTransformer c => [c] -> Doc
genMake :: forall c. RuleTransformer c => [c] -> Doc
genMake = Makefile -> Doc
build (Makefile -> Doc) -> ([c] -> Makefile) -> [c] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> Makefile
forall c. RuleTransformer c => [c] -> Makefile
toMake
build :: Makefile -> Doc
build :: Makefile -> Doc
build (M [Rule]
rules) = [Rule] -> Doc -> Doc
addCommonFeatures [Rule]
rules (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
vcat ((Rule -> Doc) -> [Rule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Rule
x -> Rule -> Doc
printRule Rule
x Doc -> Doc -> Doc
$+$ String -> Doc
text String
"") [Rule]
rules) Doc -> Doc -> Doc
$$ [Rule] -> Doc
printPhony [Rule]
rules
printRule :: Rule -> Doc
printRule :: Rule -> Doc
printRule (R Annotation
c Target
t Dependencies
d Type
_ [Command]
cmd) = Annotation -> Doc
printComments Annotation
c Doc -> Doc -> Doc
$+$ Target -> Dependencies -> Doc
printTarget Target
t Dependencies
d Doc -> Doc -> Doc
$+$ [Command] -> Doc
printCmds [Command]
cmd
printComment :: Comment -> Doc
[] = Doc
empty
printComment String
c = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (WrapSettings -> Int -> Text -> Text
wrapText WrapSettings
wrapSettings Int
80 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
wrapSettings :: WrapSettings
wrapSettings :: WrapSettings
wrapSettings = WrapSettings { preserveIndentation :: Bool
preserveIndentation = Bool
True
, breakLongWords :: Bool
breakLongWords = Bool
False
, fillStrategy :: FillStrategy
fillStrategy = Text -> FillStrategy
FillPrefix (String -> Text
T.pack String
"# ")
, fillScope :: FillScope
fillScope = FillScope
FillAll
}
printComments :: Annotation -> Doc
= (String -> Doc -> Doc) -> Doc -> Annotation -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (String -> Doc) -> String -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
printComment) Doc
empty
printPhony :: [Rule] -> Doc
printPhony :: [Rule] -> Doc
printPhony = Doc -> Doc -> Doc
(<+>) (String -> Doc
text String
".PHONY:") (Doc -> Doc) -> ([Rule] -> Doc) -> [Rule] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Rule] -> [Doc]) -> [Rule] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rule -> Doc) -> [Rule] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(R Annotation
_ Target
t Dependencies
_ Type
_ [Command]
_) -> String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Target -> String
renderMS Target
t) ([Rule] -> [Doc]) -> ([Rule] -> [Rule]) -> [Rule] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Rule -> Bool) -> [Rule] -> [Rule]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(R Annotation
_ Target
_ Dependencies
_ Type
t [Command]
_) -> Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Abstract)
printTarget :: Target -> Dependencies -> Doc
printTarget :: Target -> Dependencies -> Doc
printTarget Target
nameLb Dependencies
deps = String -> Doc
text (Target -> String
renderMS Target
nameLb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Target -> Doc) -> Dependencies -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (Target -> String) -> Target -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> String
renderMS) Dependencies
deps)
printCmd :: Command -> Doc
printCmd :: Command -> Doc
printCmd (C Target
c [CommandOpts]
opts) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (if CommandOpts
IgnoreReturnCode CommandOpts -> [CommandOpts] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandOpts]
opts then String
"-" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ Target -> String
renderMS Target
c
printCmds :: [Command] -> Doc
printCmds :: [Command] -> Doc
printCmds = (Command -> Doc -> Doc) -> Doc -> [Command] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (Command -> Doc) -> Command -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc
(<>) Doc
tab (Doc -> Doc) -> (Command -> Doc) -> Command -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Doc
printCmd) Doc
empty