never executed always true always false

    1 module Conjure.UI.Split ( outputSplittedModels, removeUnusedDecls ) where
    2 
    3 import Conjure.Prelude
    4 import Conjure.Language.Definition
    5 import Conjure.Language.Pretty
    6 
    7 -- pipes
    8 import Pipes ( Producer, yield )
    9 import qualified Pipes.Prelude as Pipes ( foldM )
   10 
   11 
   12 outputSplittedModels
   13     :: (MonadIO m, MonadFail m)
   14     => FilePath
   15     -> Model
   16     -> m ()
   17 outputSplittedModels outputDirectory model = do
   18     liftIO $ createDirectoryIfMissing True outputDirectory
   19     let
   20         each i eprime = do
   21             let gen = padLeft 6 '0' (show i)
   22             let filename = outputDirectory </> "splitted" ++ gen ++ ".essence"
   23             liftIO $ writeFile filename (renderNormal eprime)
   24             return (i+1)
   25     Pipes.foldM each
   26                 (return (1 :: Int))
   27                 (const $ return ())
   28                 (split model)
   29 
   30 
   31 split
   32     :: MonadIO m
   33     => Model
   34     -> Producer Model m ()
   35 split m = do
   36     let upd stmts = m { mStatements = stmts }
   37     let
   38         -- Right indicates "declarations", out of these only the needed ones will stay.
   39         -- Left indicates "other statements", subsets of these will be in the output.
   40         toPermute st@Declaration{}       = Right st
   41         toPermute st@SearchOrder{}       = Right st
   42         toPermute st@SearchHeuristic{}   = Right st
   43         toPermute (Where xs)             = Left [Where [x] | x <- xs]
   44         toPermute st@Objective{}         = Left [st]
   45         toPermute (SuchThat xs)          = Left [SuchThat [x] | x <- xs]
   46     let (statements, decls) = mStatements m |> map toPermute |> partitionEithers
   47     forM_ (statements
   48             |> concat
   49             |> sortNub              -- remove duplicates
   50             |> subsequences         -- generate all subsequences
   51             |> tail                 -- drop the first, contains nothing
   52           ) $ \ stmts ->
   53         Pipes.yield $ removeUnusedDecls $ upd $ decls ++ stmts
   54     forM_ (sortNub decls) $ \ decl ->
   55         Pipes.yield $ upd [decl]
   56 
   57 
   58 removeUnusedDecls :: Model -> Model
   59 removeUnusedDecls m = m { mStatements = stmts }
   60     where
   61         stmts = concat
   62             [ case declared st of
   63                 Just nm | nbUses nm after == 0 -> []
   64                 _ -> [st]
   65             | (st, after) <- withAfter (mStatements m)
   66             ]
   67 
   68         declared (Declaration (FindOrGiven _ nm _)) = return nm
   69         declared (Declaration (Letting nm _)) = return nm
   70         declared (Declaration (GivenDomainDefnEnum nm)) = return nm
   71         declared (Declaration (LettingDomainDefnEnum nm _)) = return nm
   72         declared (Declaration (LettingDomainDefnUnnamed nm _)) = return nm
   73         declared _ = Nothing