{-# 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 ..} = [ Key "targetFamily" Key -> Text -> a forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text T.pack String targetFamily , Key "targetDevice" Key -> Text -> a forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 $ [ [ Key "project" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text T.pack String projectName ] , [ Key "top" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text T.pack String topName ] , Target -> [Pair] forall a. KeyValue a => Target -> [a] targetMustache Target fpga , [ Key "srcs" Key -> [Value] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [[Value]] -> [Value] forall a. Monoid a => [a] -> a mconcat [ [ [Pair] -> Value object [ Key "fileName" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (String rootDir String -> String -> String </> String src) ] | String src <- [String] srcs1 ] , [ [Pair] -> Value object [ Key "fileName" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (String rootDir String -> String -> String </> String srcDir String -> String -> String </> String src) ] | String src <- [String] srcs2 ] ] ] , [ Key "tclSrcs" Key -> [Value] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [ [Pair] -> Value object [ Key "fileName" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (String rootDir String -> String -> String </> String srcDir String -> String -> String </> String src) ] | String src <- [String] tcls ] ] , [ Key "ipcores" Key -> [Value] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [ [Pair] -> Value object [ Key "fileName" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (String rootDir String -> String -> String </> String srcDir String -> String -> String </> String core) ] | String core <- [String] cores ] ] , [ Key "constraintSrcs" Key -> [Value] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [ [Pair] -> Value object [ Key "fileName" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> 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] ] }