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, (<.>), (</>))

-- | @'need'@ a file and all its dependencies
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

-- | 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 <- 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]
extractFromProgBase :: forall (f :: * -> *) vn. ProgBase f vn -> [FilePath]
extractFromProgBase (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]
extractFromDecBase :: forall (f :: * -> *) vn. DecBase f vn -> [FilePath]
extractFromDecBase (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]
extractFromModExpBase :: forall (f :: * -> *) vn. ModExpBase f vn -> [FilePath]
extractFromModExpBase (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{}              = []