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

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

-- | @'need'@ a file and all its dependencies
needFut :: [FilePath] -> Action ()
needFut :: [FilePath] -> Action ()
needFut fps :: [FilePath]
fps =
    Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need ([FilePath] -> Action ()) -> Action [FilePath] -> Action ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [FilePath] -> Action [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([[FilePath]] -> [FilePath])
-> ([[FilePath]] -> [[FilePath]]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath]
fps [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
:) ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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]
getAllFutDeps [FilePath]
fps)

getFutDeps :: FilePath -> IO [FilePath]
getFutDeps :: FilePath -> IO [FilePath]
getFutDeps fp :: FilePath
fp = 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
<.> "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 fp :: 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]
getFutDeps [FilePath]
deps
    let next :: [FilePath]
next = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat ([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

extractFromProgBase :: ProgBase f vn -> [FilePath]
extractFromProgBase :: ProgBase f vn -> [FilePath]
extractFromProgBase (Prog _ ds :: [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 fp :: FilePath
fp _ _)             = [FilePath
fp]
extractFromDecBase (LocalDec d :: DecBase f vn
d _)                 = DecBase f vn -> [FilePath]
forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase DecBase f vn
d
extractFromDecBase (OpenDec d :: ModExpBase f vn
d _)                  = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
d
extractFromDecBase (ModDec (ModBind _ _ _ m :: ModExpBase f vn
m _ _)) = 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 m :: ModExpBase f vn
m _)       = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModImport fp :: FilePath
fp _ _)    = [FilePath
fp]
extractFromModExpBase (ModDecs ds :: [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
extractFromModExpBase (ModApply m :: ModExpBase f vn
m m' :: ModExpBase f vn
m' _ _ _) = (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 m :: ModExpBase f vn
m _ _ _)  = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase (ModLambda _ _ m :: ModExpBase f vn
m _)   = ModExpBase f vn -> [FilePath]
forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase ModExpBase f vn
m
extractFromModExpBase ModVar{}              = []