{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Command.Overview
( command
, CommandOptions(..)
, CommandSummary(..)
, ErrorCode
)
where
import Control.Monad.Except (runExceptT)
import Data.Aeson (ToJSON (..))
import Data.List (nub, (\\))
import GHC.Generics (Generic)
import Data.OgmaSpec (ExternalVariableDef (..), InternalVariableDef (..),
Requirement (..), Spec (..))
import Command.Common
import Command.Errors (ErrorCode, ErrorTriplet(..))
import Command.Result (Result (..))
import Data.Location (Location (..))
import Language.Trans.Spec2Copilot (specAnalyze)
command :: FilePath
-> CommandOptions
-> IO (Maybe CommandSummary, Result ErrorCode)
command :: FilePath
-> CommandOptions -> IO (Maybe CommandSummary, Result ErrorCode)
command FilePath
fp CommandOptions
options = do
let functions :: ExprPair
functions = FilePath -> ExprPair
exprPair (CommandOptions -> FilePath
commandPropFormat CommandOptions
options)
copilot <- FilePath
-> CommandOptions
-> ExprPair
-> IO (Either FilePath CommandSummary)
command' FilePath
fp CommandOptions
options ExprPair
functions
return $ commandResult options fp copilot
command' :: FilePath
-> CommandOptions
-> ExprPair
-> IO (Either String CommandSummary)
command' :: FilePath
-> CommandOptions
-> ExprPair
-> IO (Either FilePath CommandSummary)
command' FilePath
fp CommandOptions
options (ExprPair ExprPairT a
exprT) = do
spec <- ExceptT ErrorTriplet IO (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ErrorTriplet IO (Spec a)
-> IO (Either ErrorTriplet (Spec a)))
-> ExceptT ErrorTriplet IO (Spec a)
-> IO (Either ErrorTriplet (Spec a))
forall a b. (a -> b) -> a -> b
$ FilePath -> ExceptT ErrorTriplet IO (Spec a)
parseInputFile' FilePath
fp
let spec' = (ErrorTriplet -> Either FilePath (Spec a))
-> (Spec a -> Either FilePath (Spec a))
-> Either ErrorTriplet (Spec a)
-> Either FilePath (Spec a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(ErrorTriplet ErrorCode
_ec FilePath
msg Location
_loc) -> FilePath -> Either FilePath (Spec a)
forall a b. a -> Either a b
Left FilePath
msg) Spec a -> Either FilePath (Spec a)
forall a b. b -> Either a b
Right Either ErrorTriplet (Spec a)
spec
let summary = do
spec1 <- Either FilePath (Spec a)
spec'
spec3 <- specAnalyze $ addMissingIdentifiers ids spec1
return $ CommandSummary (length (externalVariables spec3))
(length (internalVariables spec3))
(length (requirements spec3))
return summary
where
parseInputFile' :: FilePath -> ExceptT ErrorTriplet IO (Spec a)
parseInputFile' FilePath
f = FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
forall a.
FilePath
-> FilePath
-> FilePath
-> Maybe FilePath
-> ExprPairT a
-> ExceptT ErrorTriplet IO (Spec a)
parseInputFile FilePath
f FilePath
formatName FilePath
propFormatName Maybe FilePath
propVia ExprPairT a
exprT
formatName :: FilePath
formatName = CommandOptions -> FilePath
commandFormat CommandOptions
options
propFormatName :: FilePath
propFormatName = CommandOptions -> FilePath
commandPropFormat CommandOptions
options
propVia :: Maybe FilePath
propVia = CommandOptions -> Maybe FilePath
commandPropVia CommandOptions
options
ExprPairT FilePath -> Either FilePath a
_parse [(FilePath, FilePath)] -> a -> a
_replace a -> FilePath
_print a -> [FilePath]
ids a
_def = ExprPairT a
exprT
data CommandSummary = CommandSummary
{ CommandSummary -> ErrorCode
commandExternalVariables :: Int
, CommandSummary -> ErrorCode
commandInternalVariables :: Int
, CommandSummary -> ErrorCode
commandRequirements :: Int
}
deriving ((forall x. CommandSummary -> Rep CommandSummary x)
-> (forall x. Rep CommandSummary x -> CommandSummary)
-> Generic CommandSummary
forall x. Rep CommandSummary x -> CommandSummary
forall x. CommandSummary -> Rep CommandSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommandSummary -> Rep CommandSummary x
from :: forall x. CommandSummary -> Rep CommandSummary x
$cto :: forall x. Rep CommandSummary x -> CommandSummary
to :: forall x. Rep CommandSummary x -> CommandSummary
Generic, ErrorCode -> CommandSummary -> ShowS
[CommandSummary] -> ShowS
CommandSummary -> FilePath
(ErrorCode -> CommandSummary -> ShowS)
-> (CommandSummary -> FilePath)
-> ([CommandSummary] -> ShowS)
-> Show CommandSummary
forall a.
(ErrorCode -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ErrorCode -> CommandSummary -> ShowS
showsPrec :: ErrorCode -> CommandSummary -> ShowS
$cshow :: CommandSummary -> FilePath
show :: CommandSummary -> FilePath
$cshowList :: [CommandSummary] -> ShowS
showList :: [CommandSummary] -> ShowS
Show)
instance ToJSON CommandSummary
data CommandOptions = CommandOptions
{ CommandOptions -> FilePath
commandFormat :: String
, CommandOptions -> FilePath
commandPropFormat :: String
, CommandOptions -> Maybe FilePath
commandPropVia :: Maybe String
}
ecOverviewError :: ErrorCode
ecOverviewError :: ErrorCode
ecOverviewError = ErrorCode
1
commandResult :: CommandOptions
-> FilePath
-> Either String a
-> (Maybe a, Result ErrorCode)
commandResult :: forall a.
CommandOptions
-> FilePath -> Either FilePath a -> (Maybe a, Result ErrorCode)
commandResult CommandOptions
_options FilePath
fp Either FilePath a
result = case Either FilePath a
result of
Left FilePath
msg -> (Maybe a
forall a. Maybe a
Nothing, ErrorCode -> FilePath -> Location -> Result ErrorCode
forall a. a -> FilePath -> Location -> Result a
Error ErrorCode
ecOverviewError FilePath
msg (FilePath -> Location
LocationFile FilePath
fp))
Right a
t -> (a -> Maybe a
forall a. a -> Maybe a
Just a
t, Result ErrorCode
forall a. Result a
Success)
addMissingIdentifiers :: (a -> [String]) -> Spec a -> Spec a
addMissingIdentifiers :: forall a. (a -> [FilePath]) -> Spec a -> Spec a
addMissingIdentifiers a -> [FilePath]
f Spec a
s = Spec a
s { externalVariables = vars' }
where
vars' :: [ExternalVariableDef]
vars' = Spec a -> [ExternalVariableDef]
forall a. Spec a -> [ExternalVariableDef]
externalVariables Spec a
s [ExternalVariableDef]
-> [ExternalVariableDef] -> [ExternalVariableDef]
forall a. [a] -> [a] -> [a]
++ [ExternalVariableDef]
newVars
newVars :: [ExternalVariableDef]
newVars = (FilePath -> ExternalVariableDef)
-> [FilePath] -> [ExternalVariableDef]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
n -> FilePath -> FilePath -> ExternalVariableDef
ExternalVariableDef FilePath
n FilePath
"") [FilePath]
newVarNames
newVarNames :: [FilePath]
newVarNames = [FilePath]
identifiers [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
existingNames
identifiers :: [FilePath]
identifiers = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Requirement a -> [FilePath]) -> [Requirement a] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> [FilePath]
f (a -> [FilePath])
-> (Requirement a -> a) -> Requirement a -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Requirement a -> a
forall a. Requirement a -> a
requirementExpr) (Spec a -> [Requirement a]
forall a. Spec a -> [Requirement a]
requirements Spec a
s)
existingNames :: [FilePath]
existingNames = (ExternalVariableDef -> FilePath)
-> [ExternalVariableDef] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ExternalVariableDef -> FilePath
externalVariableName (Spec a -> [ExternalVariableDef]
forall a. Spec a -> [ExternalVariableDef]
externalVariables Spec a
s)
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (InternalVariableDef -> FilePath)
-> [InternalVariableDef] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map InternalVariableDef -> FilePath
internalVariableName (Spec a -> [InternalVariableDef]
forall a. Spec a -> [InternalVariableDef]
internalVariables Spec a
s)