Main.hs 4.2 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ExistentialQuantification #-}

module Main (main) where

import           Data.Vector                    ( Vector )
import qualified Data.Vector                   as V
import qualified Data.Text.Lazy.IO             as T
import           Data.Text                      ( Text )
import qualified Data.Text.Lazy.Builder        as Build
import qualified Options.Applicative           as Options
import qualified Text.Megaparsec               as Mega
import qualified Text.Megaparsec.Char          as Mega
import qualified Text.Megaparsec.Char.Lexer    as Mega
import           Data.Void
import           System.Random
import           System.IO
21
import           Numeric
22 23 24 25

import           Types
import           Generator
import           Output
26
import           Probability
27 28 29 30 31 32 33

data SomeMonoid = forall m. SomeMonoid (MonoidType m)

data Opts = Opts
  { optMonoid :: SomeMonoid
  , optStates :: Int
  , optSymbols :: SymbolSpec
34
  , optZeroFrequency :: Probability
35
  , optRandomState :: Maybe StdGen
36
  , optDifferentValues :: Maybe Int
37 38 39 40 41
  }

readMonoid :: Options.ReadM SomeMonoid
readMonoid = Options.eitherReader $ \case
  "Z,max"    -> Right (SomeMonoid MaxInt)
42
  "Word,or"  -> Right (SomeMonoid OrWord)
43 44 45 46 47 48
  "powerset" -> Right (SomeMonoid Powerset)
  _ ->
    Left
      $  "Unknown monoid type. Valid values are '"
      <> "Z,max"
      <> "', '"
49
      <> "Word,or"
50 51 52 53 54 55 56 57 58 59
      <> "' and '"
      <> "powerset"
      <> "'"

readSymbols :: Options.ReadM SymbolSpec
readSymbols = Options.maybeReader (Mega.parseMaybe parser)
  where
    parser :: Mega.Parsec Void String (Vector Int)
    parser = V.fromList <$> Mega.decimal `Mega.sepBy` (Mega.string ",")

60 61 62 63 64 65
readCount :: String -> Either String Int
readCount input = case readDec input of
  [(0, "")] -> Left "Count must be >0"
  [(x, "")] -> Right x
  _ -> Left "Count not parse Number"

66 67 68 69 70 71 72 73 74
parseOpts :: Options.Parser Opts
parseOpts =
  Opts
    <$> Options.option
          readMonoid
          (Options.long "monoid" <> Options.metavar "MONOID" <> Options.help
            (  "Monoid to use. Valid valies are '"
            <> "Z,max"
            <> "', '"
75
            <> "Word,or"
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
            <> "' and '"
            <> "powerset"
            <> "'"
            )
          )
    <*> Options.option
          Options.auto
          (Options.long "states" <> Options.metavar "NUM" <> Options.help
            "Number of states to generate"
          )
    <*> Options.option
          readSymbols
          (  Options.long "symbols"
          <> Options.metavar "NUM,NUM,..."
          <> Options.help
               "Comma separated list of symbols per arity. E.g. 2,0,1 means two symbols with arity 0, non with arity 1 and one with arity two"
          )
    <*> Options.option
94
          (Options.eitherReader readProbability)
95 96
          (  Options.long "zero-frequency"
          <> Options.showDefault
97
          <> Options.value (Probability 7 1)
98
          <> Options.metavar "FREQ"
99 100
          <> Options.help
               "Frequency of edges with zero weight as number between 0 and 1."
101 102 103
          )
    <*> Options.optional
          (Options.option Options.auto (Options.long "random-state"))
104 105
    <*> Options.optional
          (Options.option (Options.eitherReader readCount) (Options.long "different-values" <> Options.metavar "NUM" <> Options.help "Maximal number of differnt monoid values to generate"))
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124

withSpec :: Opts -> (forall m . WTASpec m -> x) -> x
withSpec opts f = case optMonoid opts of
  SomeMonoid m -> f WTASpec { monoid     = m
                            , numStates  = optStates opts
                            , numSymbols = optSymbols opts
                            }

main :: IO ()
main = do
  let optSpec =
        Options.info (parseOpts Options.<**> Options.helper) (Options.fullDesc)
  opts <- Options.execParser optSpec

  case optRandomState opts of
    Nothing -> return ()
    Just x  -> setStdGen x

  withSpec opts $ \spec -> do
125
    randGen <- getStdGen
126
    wta <- runGenerator (GeneratorConfig spec (optZeroFrequency opts) (optDifferentValues opts)) genWTA
127
    putStrLn $ "# Random state for this automaton: '" <> show randGen <> "'"
128
    T.putStr (Build.toLazyText (buildWTA wta))