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 <- forall a. FilePath -> IO a -> Action a
traced FilePath
"getFutDeps" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO [FilePath]
getFutDeps [FilePath]
fps
Partial => [FilePath] -> Action ()
need (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
next)
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 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO FilePath
canonicalizeRelative 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Partial => FilePath -> a
errorforall b c a. (b -> c) -> (a -> b) -> a -> c
.SyntaxError -> FilePath
showErr) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either SyntaxError UncheckedProg
parseFuthark FilePath
fp Text
contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath
dirFile FilePath -> FilePath -> FilePath
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
<.> FilePath
"fut") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) vn. ProgBase f vn -> [FilePath]
extractFromProgBase UncheckedProg
parsed)
where showErr :: SyntaxError -> FilePath
showErr (SyntaxError Loc
l Text
str) = forall a. Located a => a -> FilePath
locStr Loc
l forall a. [a] -> [a] -> [a]
++ 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO [FilePath]
getAllFutDeps [FilePath]
deps
let next :: [FilePath]
next = forall a. Ord a => [a] -> [a]
nubOrd (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath]
deps forall a. a -> [a] -> [a]
: [[FilePath]]
level))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if 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 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) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase [DecBase f vn]
ds
extractFromDecBase :: DecBase f vn -> [FilePath]
(ImportDec FilePath
fp f FilePath
_ SrcLoc
_) = [FilePath
fp]
extractFromDecBase (LocalDec DecBase f vn
d SrcLoc
_) = forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase DecBase f vn
d
extractFromDecBase (OpenDec ModExpBase f vn
d SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
d
extractFromDecBase (ModDec (ModBind vn
_ [ModParamBase f vn]
_ Maybe (SigExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m Maybe DocComment
_ SrcLoc
_)) = forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromDecBase ValDec{} = []
extractFromDecBase TypeDec{} = []
extractFromDecBase SigDec{} = []
extractFromModExpBase :: ModExpBase f vn -> [FilePath]
(ModParens ModExpBase f vn
m SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModImport FilePath
fp f FilePath
_ SrcLoc
_) = [FilePath
fp]
extractFromModExpBase (ModDecs [DecBase f vn]
ds SrcLoc
_) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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
_) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase [ModExpBase f vn
m, ModExpBase f vn
m']
extractFromModExpBase (ModAscript ModExpBase f vn
m SigExpBase f vn
_ f (Map VName VName)
_ SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModLambda ModParamBase f vn
_ Maybe (SigExpBase f vn, f (Map VName VName))
_ ModExpBase f vn
m SrcLoc
_) = forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase ModVar{} = []