module NLP.GenI.Flag where
import Data.List ( find )
import qualified Data.Set as Set
import Data.Maybe ( catMaybes, fromJust )
import Data.Text ( Text )
import Data.Typeable
import NLP.GenI.FeatureStructure ( Flist )
import NLP.GenI.GeniVal ( GeniVal )
import NLP.GenI.Polarity.Types
data Optimisation = PolOpts
| AdjOpts
| Polarised
| NoConstraints
deriving (Show,Eq,Typeable)
type Instruction = (FilePath, Maybe [Text])
data BuilderType = SimpleBuilder | SimpleOnePhaseBuilder
deriving (Eq, Typeable)
data GrammarType = GeniHand
| PreCompiled
| PreAnchored
deriving (Show, Eq, Typeable)
instance Show BuilderType where
show SimpleBuilder = "simple-2p"
show SimpleOnePhaseBuilder = "simple-1p"
data Flag = forall f x . (Eq f, Typeable f, Typeable x) =>
Flag (x -> f) x deriving (Typeable)
instance Eq Flag where
(Flag f1 x1) == (Flag f2 x2)
| (typeOf f1 == typeOf f2) && (typeOf x1 == typeOf x2) =
(fromJust . cast . f1 $ x1) == (f2 x2)
| otherwise = False
isFlag :: (Typeable f, Typeable x) => (x -> f) -> Flag -> Bool
isFlag f1 (Flag f2 _) = typeOf f1 == typeOf f2
hasFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> Bool
hasFlag = any . isFlag
deleteFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> [Flag]
deleteFlag f = filter (not.(isFlag f))
modifyFlag :: (Eq f, Typeable f, Typeable x) => (x -> f) -> (x -> x) -> [Flag] -> [Flag]
modifyFlag f m fs =
case getFlag f fs of
Nothing -> fs
Just v -> setFlag f (m v) fs
setFlag :: (Eq f, Typeable f, Typeable x) => (x -> f) -> x -> [Flag] -> [Flag]
setFlag f v fs = (Flag f v) : tl where tl = deleteFlag f fs
getFlag :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> Maybe x
getFlag f fs = do (Flag _ v) <- find (isFlag f) fs ; cast v
getAllFlags :: (Typeable f, Typeable x) => (x -> f) -> [Flag] -> [x]
getAllFlags f fs = catMaybes [ cast v | flg@(Flag _ v) <- fs, isFlag f flg ]
newtype BatchDirFlg = BatchDirFlg FilePath deriving (Eq, Typeable)
newtype DisableGuiFlg = DisableGuiFlg () deriving (Eq, Typeable)
newtype DetectPolaritiesFlg = DetectPolaritiesFlg (Set.Set PolarityAttr) deriving (Eq, Typeable)
newtype DumpDerivationFlg = DumpDerivationFlg () deriving (Eq, Typeable)
newtype EarlyDeathFlg = EarlyDeathFlg () deriving (Eq, Typeable)
newtype FromStdinFlg = FromStdinFlg () deriving (Eq, Typeable)
newtype HelpFlg = HelpFlg () deriving (Eq, Typeable)
newtype InstructionsFileFlg = InstructionsFileFlg FilePath deriving (Eq, Typeable)
newtype LexiconFlg = LexiconFlg FilePath deriving (Eq, Typeable)
newtype MacrosFlg = MacrosFlg FilePath deriving (Eq, Typeable)
newtype TracesFlg = TracesFlg FilePath deriving (Eq, Typeable)
newtype MaxStepsFlg = MaxStepsFlg Integer deriving (Eq, Typeable)
newtype MaxResultsFlg = MaxResultsFlg Integer deriving (Eq, Typeable)
newtype MetricsFlg = MetricsFlg [String] deriving (Eq, Typeable)
newtype MorphCmdFlg = MorphCmdFlg String deriving (Eq, Typeable)
newtype MorphInfoFlg = MorphInfoFlg FilePath deriving (Eq, Typeable)
newtype OptimisationsFlg = OptimisationsFlg [Optimisation] deriving (Eq, Typeable)
newtype OutputFileFlg = OutputFileFlg String deriving (Eq, Typeable)
newtype PartialFlg = PartialFlg () deriving (Eq, Typeable)
newtype RankingConstraintsFlg = RankingConstraintsFlg FilePath deriving (Eq, Typeable)
newtype RootFeatureFlg = RootFeatureFlg (Flist GeniVal) deriving (Eq, Typeable)
newtype NoLoadTestSuiteFlg = NoLoadTestSuiteFlg () deriving (Eq, Typeable)
newtype StatsFileFlg = StatsFileFlg FilePath deriving (Eq, Typeable)
newtype TestCaseFlg = TestCaseFlg Text deriving (Eq, Typeable)
newtype TestInstructionsFlg = TestInstructionsFlg [Instruction] deriving (Eq, Typeable)
newtype TestSuiteFlg = TestSuiteFlg FilePath deriving (Eq, Typeable)
newtype TimeoutFlg = TimeoutFlg Int deriving (Eq, Typeable)
newtype VerboseModeFlg = VerboseModeFlg () deriving (Eq, Typeable)
newtype VersionFlg = VersionFlg () deriving (Eq, Typeable)
newtype ViewCmdFlg = ViewCmdFlg String deriving (Eq, Typeable)
newtype BuilderFlg = BuilderFlg BuilderType deriving (Eq, Typeable)
newtype GrammarTypeFlg = GrammarTypeFlg GrammarType deriving (Eq, Typeable)
newtype WeirdFlg = WeirdFlg String deriving (Eq, Typeable)