module Development.Shake.Futhark ( getFutDeps
                                 , getAllFutDeps
                                 , needFut
                                 ) where

import           Control.Monad             ((<=<))
import           Data.Containers.ListUtils (nubOrd)
import           Data.Foldable             (traverse_)
import qualified Data.Text.IO              as TIO
import           Development.Shake         (Action, need, traced)
import           Language.Futhark.Parser   (parseFuthark)
import           Language.Futhark.Syntax   (DecBase (..), ModBindBase (ModBind), ModExpBase (..), ProgBase (Prog))
import           System.Directory          (canonicalizePath, makeRelativeToCurrentDirectory)
import           System.FilePath           (takeDirectory, (<.>), (</>))

-- | @'need'@ a file and all its dependencies
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)
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)
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 = (ParseError -> UncheckedProg)
-> (UncheckedProg -> UncheckedProg)
-> Either ParseError 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)
-> (ParseError -> FilePath) -> ParseError -> UncheckedProg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseError -> FilePath
forall a. Show a => a -> FilePath
show) UncheckedProg -> UncheckedProg
forall a. a -> a
id (Either ParseError UncheckedProg -> UncheckedProg)
-> Either ParseError UncheckedProg -> UncheckedProg
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either ParseError UncheckedProg
parseFuthark FilePath
fp Text
contents
    [FilePath] -> IO [FilePath]
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)

-- | Get all transitive dependencies
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)
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 (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 (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]
extractFromProgBase :: ProgBase f vn -> [FilePath]
extractFromProgBase (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]
extractFromDecBase :: DecBase f vn -> [FilePath]
extractFromDecBase (ImportDec FilePath
fp f FilePath
_ 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 (SigExpBase 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 SigDec{}                       = []

extractFromModExpBase :: ModExpBase f vn -> [FilePath]
extractFromModExpBase :: ModExpBase f vn -> [FilePath]
extractFromModExpBase (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 FilePath
_ 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 SigExpBase 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 (SigExpBase 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{}              = []