{-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell #-}
module Clash.Shake.Intel
( Target(..)
, de0Nano, arrowDeca
, quartus
) where
import Clash.Shake
import Development.Shake
import Development.Shake.Command
import Development.Shake.FilePath
import Development.Shake.Config
import Text.Mustache
import qualified Text.Mustache.Compile.TH as TH
import Data.Aeson
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.IO as T
data Target = Target
{ Target -> String
targetFamily :: String
, Target -> String
targetDevice :: String
}
targetMustache :: Target -> [a]
targetMustache Target{String
targetDevice :: String
targetFamily :: String
targetDevice :: Target -> String
targetFamily :: Target -> String
..} =
[ Text
"targetFamily" Text -> Text -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
targetFamily
, Text
"targetDevice" Text -> Text -> a
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
targetDevice
]
de0Nano :: Target
de0Nano :: Target
de0Nano = String -> String -> Target
Target String
"Cyclone IV E" String
"EP4CE22F17C6"
arrowDeca :: Target
arrowDeca :: Target
arrowDeca = String -> String -> Target
Target String
"MAX 10" String
"10M50DAF484C6GES"
quartus :: Target -> ClashKit -> FilePath -> FilePath -> String -> Rules SynthKit
quartus :: Target -> ClashKit -> String -> String -> String -> Rules SynthKit
quartus Target
fpga kit :: ClashKit
kit@ClashKit{Action [String]
manifestSrcs :: ClashKit -> Action [String]
manifestSrcs :: Action [String]
..} String
outDir String
srcDir String
topName = do
let projectName :: String
projectName = String
topName
rootDir :: String
rootDir = [String] -> String
joinPath ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a b. a -> b -> a
const String
"..") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
outDir
let quartus :: String -> [String] -> Action ()
quartus String
tool [String]
args = (CmdOption -> [String] -> Action ()) :-> Action ()
forall args. (Partial, CmdArguments args, Unit args) => args
cmd_ (String -> CmdOption
Cwd String
outDir) ([String] -> Action ()) -> Action [String] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> [String] -> Action [String]
toolchain String
"QUARTUS" String
tool [String]
args
let getFiles :: String -> [String] -> Action [String]
getFiles String
dir [String]
pats = String -> [String] -> Action [String]
getDirectoryFiles String
srcDir [ String
dir String -> String -> String
</> String
pat | String
pat <- [String]
pats ]
hdlSrcs :: Action [String]
hdlSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.vhdl", String
"*.v", String
"*.sv"]
tclSrcs :: Action [String]
tclSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.tcl"]
constrSrcs :: Action [String]
constrSrcs = String -> [String] -> Action [String]
getFiles String
"src-hdl" [String
"*.sdc"]
ipCores :: Action [String]
ipCores = String -> [String] -> Action [String]
getFiles String
"ip" [String
"//*.qip"]
String
outDir String -> String -> String
<//> String
"*.tcl" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
[String]
srcs1 <- Action [String]
manifestSrcs
[String]
srcs2 <- Action [String]
hdlSrcs
[String]
tcls <- Action [String]
tclSrcs
[String]
constrs <- Action [String]
constrSrcs
[String]
cores <- Action [String]
ipCores
let template :: Template
template = $(TH.compileMustacheFile "template/intel-quartus/project.tcl.mustache")
let values :: Value
values = [Pair] -> Value
object ([Pair] -> Value) -> ([[Pair]] -> [Pair]) -> [[Pair]] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> Value) -> [[Pair]] -> Value
forall a b. (a -> b) -> a -> b
$
[ [ Text
"project" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
projectName ]
, [ Text
"top" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
topName ]
, Target -> [Pair]
forall a. KeyValue a => Target -> [a]
targetMustache Target
fpga
, [ Text
"srcs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [[Value]] -> [Value]
forall a. Monoid a => [a] -> a
mconcat
[ [ [Pair] -> Value
object [ Text
"fileName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
rootDir String -> String -> String
</> String
src) ] | String
src <- [String]
srcs1 ]
, [ [Pair] -> Value
object [ Text
"fileName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
rootDir String -> String -> String
</> String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
srcs2 ]
]
]
, [ Text
"tclSrcs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ [Pair] -> Value
object [ Text
"fileName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
rootDir String -> String -> String
</> String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
tcls ] ]
, [ Text
"ipcores" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ [Pair] -> Value
object [ Text
"fileName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
rootDir String -> String -> String
</> String
srcDir String -> String -> String
</> String
core) ] | String
core <- [String]
cores ] ]
, [ Text
"constraintSrcs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [ [Pair] -> Value
object [ Text
"fileName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
rootDir String -> String -> String
</> String
srcDir String -> String -> String
</> String
src) ] | String
src <- [String]
constrs ] ]
]
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
out (String -> Action ()) -> (Text -> String) -> Text -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack (Text -> Action ()) -> Text -> Action ()
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
renderMustache Template
template Value
values
String
outDir String -> String -> String
</> String
"ip" String -> String -> String
<//> String
"*" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let src :: String
src = String
srcDir String -> String -> String
</> String -> String -> String
makeRelative String
outDir String
out
Partial => String -> String -> Action ()
String -> String -> Action ()
copyFileChanged String
src String
out
let bitfile :: String
bitfile = String
outDir String -> String -> String
</> String
topName String -> String -> String
<.> String
"sof"
String
bitfile Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
_out -> do
[String]
srcs1 <- Action [String]
manifestSrcs
[String]
srcs2 <- Action [String]
hdlSrcs
[String]
cores <- Action [String]
ipCores
Partial => [String] -> Action ()
[String] -> Action ()
need ([String] -> Action ()) -> [String] -> Action ()
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
[ [ String
outDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"tcl" ]
, [ String
src | String
src <- [String]
srcs1 ]
, [ String
srcDir String -> String -> String
</> String
src | String
src <- [String]
srcs2 ]
, [ String
outDir String -> String -> String
</> String
core | String
core <- [String]
cores ]
]
String -> [String] -> Action ()
quartus String
"quartus_sh" [String
"-t", String
projectName String -> String -> String
<.> String
"tcl"]
String
outDir String -> String -> String
</> String
topName String -> String -> String
<.> String
"rbf" Partial => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
let sof :: String
sof = String
out String -> String -> String
-<.> String
"sof"
Partial => [String] -> Action ()
[String] -> Action ()
need [String
sof]
String -> [String] -> Action ()
quartus String
"quartus_cpf"
[ String
"--option=bitstream_compression=off"
, String
"-c", String -> String -> String
makeRelative String
outDir String
sof
, String -> String -> String
makeRelative String
outDir String
out
]
SynthKit -> Rules SynthKit
forall (m :: * -> *) a. Monad m => a -> m a
return (SynthKit -> Rules SynthKit) -> SynthKit -> Rules SynthKit
forall a b. (a -> b) -> a -> b
$ SynthKit :: String -> [(String, Action ())] -> SynthKit
SynthKit
{ bitfile :: String
bitfile = String
bitfile
, phonies :: [(String, Action ())]
phonies =
[ String
"quartus" String -> Action () -> (String, Action ())
|> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
outDir String -> String -> String
</> String
projectName String -> String -> String
<.> String
"tcl"]
String -> [String] -> Action ()
quartus String
"quartus_sh" [String
"-t", String
projectName String -> String -> String
<.> String
"tcl"]
, String
"upload" String -> Action () -> (String, Action ())
|> do
Partial => [String] -> Action ()
[String] -> Action ()
need [String
bitfile]
String -> [String] -> Action ()
quartus String
"quartus_pgm" [String
"-m", String
"jtag", String
"-o", String
"p;" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String -> String
makeRelative String
outDir String
bitfile]
]
}