{-# LANGUAGE DeriveGeneric #-}
module Command.Search
( command
, CommandOptions(..)
, SearchFile(..)
, CommandSearchResults(..)
, RequirementInfo(..)
, DiagramInfo(..)
, ErrorCode
)
where
import Control.Monad (foldM)
import Control.Monad.Except (runExceptT)
import Data.Aeson (ToJSON (..))
import Data.List (isInfixOf)
import GHC.Generics (Generic)
import Data.OgmaSpec (Requirement (..), Spec (..))
import Command.Common (InputFile (..), parseInputFile)
import Command.Errors (ErrorCode, ErrorTriplet (..))
import Command.Result (Result (..))
import Data.Diagram (Diagram (..))
import Data.ExprPair (ExprPair (..), exprPair)
import Data.Location (Location (..))
command :: CommandOptions
-> IO (Maybe CommandSearchResults, Result ErrorCode)
command :: CommandOptions -> IO (Maybe CommandSearchResults, Result Int)
command CommandOptions
options = do
fs <- (Either (FilePath, FilePath) CommandSearchResults
-> SearchFile
-> IO (Either (FilePath, FilePath) CommandSearchResults))
-> Either (FilePath, FilePath) CommandSearchResults
-> [SearchFile]
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
Either (FilePath, FilePath) CommandSearchResults
-> SearchFile
-> IO (Either (FilePath, FilePath) CommandSearchResults)
processFile
(CommandSearchResults
-> Either (FilePath, FilePath) CommandSearchResults
forall a b. b -> Either a b
Right CommandSearchResults
emptyCommandSearchResults)
(CommandOptions -> [SearchFile]
commandInputFiles CommandOptions
options)
return $ commandResult options fs
where
processFile :: Either (FilePath, String) CommandSearchResults
-> SearchFile
-> IO (Either (FilePath, String) CommandSearchResults)
processFile :: Either (FilePath, FilePath) CommandSearchResults
-> SearchFile
-> IO (Either (FilePath, FilePath) CommandSearchResults)
processFile Either (FilePath, FilePath) CommandSearchResults
acc SearchFile
file = case Either (FilePath, FilePath) CommandSearchResults
acc of
Left (FilePath, FilePath)
_ -> Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (FilePath, FilePath) CommandSearchResults
acc
Right CommandSearchResults
acc' -> do
let functions :: ExprPair
functions = FilePath -> ExprPair
exprPair (SearchFile -> FilePath
searchFilePropFormat SearchFile
file)
c <- SearchFile
-> ExprPair
-> FilePath
-> IO (Either FilePath CommandSearchResults)
command' SearchFile
file ExprPair
functions (CommandOptions -> FilePath
commandSearchQuery CommandOptions
options)
case c of
Left FilePath
msg -> Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults))
-> Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath)
-> Either (FilePath, FilePath) CommandSearchResults
forall a b. a -> Either a b
Left (SearchFile -> FilePath
searchFilePath SearchFile
file, FilePath
msg)
Right CommandSearchResults
s -> Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults))
-> Either (FilePath, FilePath) CommandSearchResults
-> IO (Either (FilePath, FilePath) CommandSearchResults)
forall a b. (a -> b) -> a -> b
$ CommandSearchResults
-> Either (FilePath, FilePath) CommandSearchResults
forall a b. b -> Either a b
Right (CommandSearchResults
-> Either (FilePath, FilePath) CommandSearchResults)
-> CommandSearchResults
-> Either (FilePath, FilePath) CommandSearchResults
forall a b. (a -> b) -> a -> b
$ CommandSearchResults
-> CommandSearchResults -> CommandSearchResults
mergeCommandSearchResults CommandSearchResults
acc' CommandSearchResults
s
command' :: SearchFile
-> ExprPair
-> String
-> IO (Either String CommandSearchResults)
command' :: SearchFile
-> ExprPair
-> FilePath
-> IO (Either FilePath CommandSearchResults)
command' SearchFile
file (ExprPair ExprPairT a
exprT) FilePath
query = do
res <- ExceptT ErrorTriplet IO (InputFile a)
-> IO (Either ErrorTriplet (InputFile a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ErrorTriplet IO (InputFile a)
-> IO (Either ErrorTriplet (InputFile a)))
-> ExceptT ErrorTriplet IO (InputFile a)
-> IO (Either ErrorTriplet (InputFile a))
forall a b. (a -> b) -> a -> b
$
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
forall a.
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (InputFile a)
parseInputFile FilePath
fp FilePath
formatName FilePath
propFormatName Maybe FilePath
propVia ExprPairT a
exprT
case res of
Left (ErrorTriplet Int
_ FilePath
s Location
_) -> Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults))
-> Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath CommandSearchResults
forall a b. a -> Either a b
Left FilePath
s
Right (InputFileDiagram Diagram
diagramR) ->
Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults))
-> Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a b. (a -> b) -> a -> b
$ CommandSearchResults -> Either FilePath CommandSearchResults
forall a b. b -> Either a b
Right (CommandSearchResults -> Either FilePath CommandSearchResults)
-> CommandSearchResults -> Either FilePath CommandSearchResults
forall a b. (a -> b) -> a -> b
$ FilePath -> Diagram -> FilePath -> CommandSearchResults
diagramResults FilePath
fp Diagram
diagramR FilePath
query
Right (InputFileSpec Spec a
spec) ->
Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults))
-> Either FilePath CommandSearchResults
-> IO (Either FilePath CommandSearchResults)
forall a b. (a -> b) -> a -> b
$ CommandSearchResults -> Either FilePath CommandSearchResults
forall a b. b -> Either a b
Right (CommandSearchResults -> Either FilePath CommandSearchResults)
-> CommandSearchResults -> Either FilePath CommandSearchResults
forall a b. (a -> b) -> a -> b
$ FilePath -> Spec a -> FilePath -> CommandSearchResults
forall a. FilePath -> Spec a -> FilePath -> CommandSearchResults
specResults FilePath
fp Spec a
spec FilePath
query
where
fp :: FilePath
fp = SearchFile -> FilePath
searchFilePath SearchFile
file
formatName :: FilePath
formatName = SearchFile -> FilePath
searchFileFormat SearchFile
file
propFormatName :: FilePath
propFormatName = SearchFile -> FilePath
searchFilePropFormat SearchFile
file
propVia :: Maybe FilePath
propVia = SearchFile -> Maybe FilePath
searchFilePropVia SearchFile
file
specResults :: FilePath -> Spec a -> String -> CommandSearchResults
specResults :: forall a. FilePath -> Spec a -> FilePath -> CommandSearchResults
specResults FilePath
file Spec a
spec FilePath
query = CommandSearchResults
{ searchResultRequirements :: [RequirementInfo]
searchResultRequirements =
[ FilePath -> FilePath -> FilePath -> RequirementInfo
RequirementInfo FilePath
file FilePath
n FilePath
d
| Requirement a
r <- Spec a -> [Requirement a]
forall a. Spec a -> [Requirement a]
requirements Spec a
spec
, let n :: FilePath
n = Requirement a -> FilePath
forall a. Requirement a -> FilePath
requirementName Requirement a
r
, let d :: FilePath
d = Requirement a -> FilePath
forall a. Requirement a -> FilePath
requirementDescription Requirement a
r
, FilePath
query FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
n Bool -> Bool -> Bool
|| FilePath
query FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
d
]
, searchResultDiagrams :: [DiagramInfo]
searchResultDiagrams = []
}
diagramResults :: FilePath -> Diagram -> String -> CommandSearchResults
diagramResults :: FilePath -> Diagram -> FilePath -> CommandSearchResults
diagramResults FilePath
file Diagram
diagramR FilePath
query = CommandSearchResults
{ searchResultRequirements :: [RequirementInfo]
searchResultRequirements = []
, searchResultDiagrams :: [DiagramInfo]
searchResultDiagrams =
[ FilePath -> DiagramInfo
DiagramInfo FilePath
file
| ((Int, FilePath, Int) -> Bool) -> [(Int, FilePath, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(Int
f, FilePath
t, Int
d) -> FilePath
query FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Int -> FilePath
forall a. Show a => a -> FilePath
show Int
f
Bool -> Bool -> Bool
|| FilePath
query FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
t
Bool -> Bool -> Bool
|| FilePath
query FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Int -> FilePath
forall a. Show a => a -> FilePath
show Int
d)
(Diagram -> [(Int, FilePath, Int)]
diagramTransitions Diagram
diagramR)
]
}
data CommandOptions = CommandOptions
{ CommandOptions -> [SearchFile]
commandInputFiles :: [ SearchFile ]
, CommandOptions -> FilePath
commandSearchQuery :: String
}
data SearchFile = SearchFile
{ SearchFile -> FilePath
searchFilePath :: FilePath
, SearchFile -> FilePath
searchFileFormat :: String
, SearchFile -> FilePath
searchFilePropFormat :: String
, SearchFile -> Maybe FilePath
searchFilePropVia :: Maybe String
}
data CommandSearchResults = CommandSearchResults
{ CommandSearchResults -> [RequirementInfo]
searchResultRequirements :: [RequirementInfo]
, CommandSearchResults -> [DiagramInfo]
searchResultDiagrams :: [DiagramInfo]
}
deriving ((forall x. CommandSearchResults -> Rep CommandSearchResults x)
-> (forall x. Rep CommandSearchResults x -> CommandSearchResults)
-> Generic CommandSearchResults
forall x. Rep CommandSearchResults x -> CommandSearchResults
forall x. CommandSearchResults -> Rep CommandSearchResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandSearchResults -> Rep CommandSearchResults x
from :: forall x. CommandSearchResults -> Rep CommandSearchResults x
$cto :: forall x. Rep CommandSearchResults x -> CommandSearchResults
to :: forall x. Rep CommandSearchResults x -> CommandSearchResults
Generic, Int -> CommandSearchResults -> ShowS
[CommandSearchResults] -> ShowS
CommandSearchResults -> FilePath
(Int -> CommandSearchResults -> ShowS)
-> (CommandSearchResults -> FilePath)
-> ([CommandSearchResults] -> ShowS)
-> Show CommandSearchResults
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommandSearchResults -> ShowS
showsPrec :: Int -> CommandSearchResults -> ShowS
$cshow :: CommandSearchResults -> FilePath
show :: CommandSearchResults -> FilePath
$cshowList :: [CommandSearchResults] -> ShowS
showList :: [CommandSearchResults] -> ShowS
Show)
instance ToJSON CommandSearchResults
emptyCommandSearchResults :: CommandSearchResults
emptyCommandSearchResults :: CommandSearchResults
emptyCommandSearchResults = CommandSearchResults
{ searchResultRequirements :: [RequirementInfo]
searchResultRequirements = []
, searchResultDiagrams :: [DiagramInfo]
searchResultDiagrams = []
}
mergeCommandSearchResults :: CommandSearchResults
-> CommandSearchResults
-> CommandSearchResults
mergeCommandSearchResults :: CommandSearchResults
-> CommandSearchResults -> CommandSearchResults
mergeCommandSearchResults CommandSearchResults
c1 CommandSearchResults
c2 = CommandSearchResults
{ searchResultRequirements :: [RequirementInfo]
searchResultRequirements =
CommandSearchResults -> [RequirementInfo]
searchResultRequirements CommandSearchResults
c1 [RequirementInfo] -> [RequirementInfo] -> [RequirementInfo]
forall a. [a] -> [a] -> [a]
++ CommandSearchResults -> [RequirementInfo]
searchResultRequirements CommandSearchResults
c2
, searchResultDiagrams :: [DiagramInfo]
searchResultDiagrams =
CommandSearchResults -> [DiagramInfo]
searchResultDiagrams CommandSearchResults
c1 [DiagramInfo] -> [DiagramInfo] -> [DiagramInfo]
forall a. [a] -> [a] -> [a]
++ CommandSearchResults -> [DiagramInfo]
searchResultDiagrams CommandSearchResults
c2
}
data RequirementInfo = RequirementInfo
{ RequirementInfo -> FilePath
requirementInfoLocation :: FilePath
, RequirementInfo -> FilePath
requirementInfoName :: String
, RequirementInfo -> FilePath
requirementInfoDescription :: String
}
deriving ((forall x. RequirementInfo -> Rep RequirementInfo x)
-> (forall x. Rep RequirementInfo x -> RequirementInfo)
-> Generic RequirementInfo
forall x. Rep RequirementInfo x -> RequirementInfo
forall x. RequirementInfo -> Rep RequirementInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequirementInfo -> Rep RequirementInfo x
from :: forall x. RequirementInfo -> Rep RequirementInfo x
$cto :: forall x. Rep RequirementInfo x -> RequirementInfo
to :: forall x. Rep RequirementInfo x -> RequirementInfo
Generic, Int -> RequirementInfo -> ShowS
[RequirementInfo] -> ShowS
RequirementInfo -> FilePath
(Int -> RequirementInfo -> ShowS)
-> (RequirementInfo -> FilePath)
-> ([RequirementInfo] -> ShowS)
-> Show RequirementInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequirementInfo -> ShowS
showsPrec :: Int -> RequirementInfo -> ShowS
$cshow :: RequirementInfo -> FilePath
show :: RequirementInfo -> FilePath
$cshowList :: [RequirementInfo] -> ShowS
showList :: [RequirementInfo] -> ShowS
Show)
instance ToJSON RequirementInfo
data DiagramInfo = DiagramInfo
{ DiagramInfo -> FilePath
diagramInfoLocation :: FilePath
}
deriving ((forall x. DiagramInfo -> Rep DiagramInfo x)
-> (forall x. Rep DiagramInfo x -> DiagramInfo)
-> Generic DiagramInfo
forall x. Rep DiagramInfo x -> DiagramInfo
forall x. DiagramInfo -> Rep DiagramInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiagramInfo -> Rep DiagramInfo x
from :: forall x. DiagramInfo -> Rep DiagramInfo x
$cto :: forall x. Rep DiagramInfo x -> DiagramInfo
to :: forall x. Rep DiagramInfo x -> DiagramInfo
Generic, Int -> DiagramInfo -> ShowS
[DiagramInfo] -> ShowS
DiagramInfo -> FilePath
(Int -> DiagramInfo -> ShowS)
-> (DiagramInfo -> FilePath)
-> ([DiagramInfo] -> ShowS)
-> Show DiagramInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiagramInfo -> ShowS
showsPrec :: Int -> DiagramInfo -> ShowS
$cshow :: DiagramInfo -> FilePath
show :: DiagramInfo -> FilePath
$cshowList :: [DiagramInfo] -> ShowS
showList :: [DiagramInfo] -> ShowS
Show)
instance ToJSON DiagramInfo
ecSearchError :: ErrorCode
ecSearchError :: Int
ecSearchError = Int
1
commandResult :: CommandOptions
-> Either (FilePath, String) a
-> (Maybe a, Result ErrorCode)
commandResult :: forall a.
CommandOptions
-> Either (FilePath, FilePath) a -> (Maybe a, Result Int)
commandResult CommandOptions
_options Either (FilePath, FilePath) a
result = case Either (FilePath, FilePath) a
result of
Left (FilePath
fp, FilePath
msg) -> (Maybe a
forall a. Maybe a
Nothing, Int -> FilePath -> Location -> Result Int
forall a. a -> FilePath -> Location -> Result a
Error Int
ecSearchError FilePath
msg (FilePath -> Location
LocationFile FilePath
fp))
Right a
t -> (a -> Maybe a
forall a. a -> Maybe a
Just a
t, Result Int
forall a. Result a
Success)