module Development.Shake.Futhark ( getFutDeps
, getAllFutDeps
, needFut
) where
import Control.Monad ((<=<))
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable (traverse_)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Development.Shake (Action, need, traced)
import Language.Futhark.Parser (SyntaxError (..), parseFuthark)
import Language.Futhark.Syntax (DecBase (..), ModBindBase (ModBind), ModExpBase (..), ProgBase (Prog), locStr)
import System.Directory (canonicalizePath, makeRelativeToCurrentDirectory)
import System.FilePath (takeDirectory, (<.>), (</>))
needFut :: [FilePath] -> Action ()
needFut :: [FilePath] -> Action ()
needFut [FilePath]
fps = do
[[FilePath]]
next <- FilePath -> IO [[FilePath]] -> Action [[FilePath]]
forall a. FilePath -> IO a -> Action a
traced FilePath
"getFutDeps" (IO [[FilePath]] -> Action [[FilePath]])
-> IO [[FilePath]] -> Action [[FilePath]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO [FilePath]
getFutDeps [FilePath]
fps
Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
next)
([FilePath] -> Action ()) -> [[FilePath]] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ [FilePath] -> Action ()
needFut [[FilePath]]
next
getFutDeps :: FilePath -> IO [FilePath]
getFutDeps :: FilePath -> IO [FilePath]
getFutDeps FilePath
fp = (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO FilePath
canonicalizeRelative ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Text
contents <- FilePath -> IO Text
TIO.readFile FilePath
fp
let dirFile :: FilePath
dirFile = FilePath -> FilePath
takeDirectory FilePath
fp
parsed :: UncheckedProg
parsed = (SyntaxError -> UncheckedProg)
-> (UncheckedProg -> UncheckedProg)
-> Either SyntaxError UncheckedProg
-> UncheckedProg
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> UncheckedProg
forall a. Partial => FilePath -> a
error(FilePath -> UncheckedProg)
-> (SyntaxError -> FilePath) -> SyntaxError -> UncheckedProg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SyntaxError -> FilePath
showErr) UncheckedProg -> UncheckedProg
forall a. a -> a
id (Either SyntaxError UncheckedProg -> UncheckedProg)
-> Either SyntaxError UncheckedProg -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either SyntaxError UncheckedProg
parseFuthark FilePath
fp Text
contents
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
dirFile FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
<.> FilePath
"fut") (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UncheckedProg -> [FilePath]
forall (f :: * -> *) vn. ProgBase f vn -> [FilePath]
extractFromProgBase UncheckedProg
parsed)
where showErr :: SyntaxError -> FilePath
showErr (SyntaxError Loc
l Text
str) = Loc -> FilePath
forall a. Located a => a -> FilePath
locStr Loc
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
str
getAllFutDeps :: FilePath -> IO [FilePath]
getAllFutDeps :: FilePath -> IO [FilePath]
getAllFutDeps FilePath
fp = do
[FilePath]
deps <- FilePath -> IO [FilePath]
getFutDeps FilePath
fp
[[FilePath]]
level <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse FilePath -> IO [FilePath]
getAllFutDeps [FilePath]
deps
let next :: [FilePath]
next = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath]
deps [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
level))
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ if [[FilePath]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[FilePath]]
level then [FilePath]
deps else [FilePath]
next
canonicalizeRelative :: FilePath -> IO FilePath
canonicalizeRelative :: FilePath -> IO FilePath
canonicalizeRelative = FilePath -> IO FilePath
makeRelativeToCurrentDirectory (FilePath -> IO FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO FilePath
canonicalizePath
extractFromProgBase :: ProgBase f vn -> [FilePath]
(Prog Maybe DocComment
_ [DecBase f vn]
ds) = (DecBase f vn -> [FilePath]) -> [DecBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase [DecBase f vn]
ds
extractFromDecBase :: DecBase f vn -> [FilePath]
(ImportDec FilePath
fp f ImportName
_ SrcLoc
_) = [FilePath
fp]
extractFromDecBase (LocalDec DecBase f vn
d SrcLoc
_) = DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase DecBase f vn
d
extractFromDecBase (OpenDec ModExpBase f vn
d SrcLoc
_) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
d
extractFromDecBase (ModDec (ModBind vn
_ [ModParamBase f vn]
_ Maybe (ModTypeExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m Maybe DocComment
_ SrcLoc
_)) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromDecBase ValDec{} = []
extractFromDecBase TypeDec{} = []
extractFromDecBase ModTypeDec{} = []
extractFromModExpBase :: ModExpBase f vn -> [FilePath]
(ModParens ModExpBase f vn
m SrcLoc
_) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModImport FilePath
fp f ImportName
_ SrcLoc
_) = [FilePath
fp]
extractFromModExpBase (ModDecs [DecBase f vn]
ds SrcLoc
_) = (DecBase f vn -> [FilePath]) -> [DecBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase [DecBase f vn]
ds
extractFromModExpBase (ModApply ModExpBase f vn
m ModExpBase f vn
m' f (Map VName VName)
_ f (Map VName VName)
_ SrcLoc
_) = (ModExpBase f vn -> [FilePath]) -> [ModExpBase f vn] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase [ModExpBase f vn
m, ModExpBase f vn
m']
extractFromModExpBase (ModAscript ModExpBase f vn
m ModTypeExpBase f vn
_ f (Map VName VName)
_ SrcLoc
_) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModLambda ModParamBase f vn
_ Maybe (ModTypeExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m SrcLoc
_) = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase ModVar{} = []