cosmetics

.stylish-haskell.yaml

@@ -0,0 +1,204 @@
+# stylish-haskell configuration file
+# ==================================
+
+# The stylish-haskell tool is mainly configured by specifying steps. These steps
+# are a list, so they have an order, and one specific step may appear more than
+# once (if needed). Each file is processed by these steps in the given order.
+steps:
+  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
+  # by default.
+  - unicode_syntax:
+     # In order to make this work, we also need to insert the UnicodeSyntax
+     # language pragma. If this flag is set to true, we insert it when it's
+     # not already present. You may want to disable it if you configure
+     # language extensions using some other method than pragmas. Default:
+     # true.
+     add_language_pragma: true
+
+  # Align the right hand side of some elements.  This is quite conservative
+  # and only applies to statements where each element occupies a single
+  # line.
+  - simple_align:
+      cases: true
+      top_level_patterns: true
+      records: true
+
+  # Import cleanup
+  - imports:
+      # There are different ways we can align names and lists.
+      #
+      # - global: Align the import names and import list throughout the entire
+      #   file.
+      #
+      # - file: Like global, but don't add padding when there are no qualified
+      #   imports in the file.
+      #
+      # - group: Only align the imports per group (a group is formed by adjacent
+      #   import lines).
+      #
+      # - none: Do not perform any alignment.
+      #
+      # Default: global.
+      align: global
+
+      # The following options affect only import list alignment.
+      #
+      # List align has following options:
+      #
+      # - after_alias: Import list is aligned with end of import including
+      #   'as' and 'hiding' keywords.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                          init, last, length)
+      #
+      # - with_alias: Import list is aligned with start of alias or hiding.
+      #
+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
+      #   >                                 init, last, length)
+      #
+      # - new_line: Import list starts always on new line.
+      #
+      #   > import qualified Data.List      as List
+      #   >     (concat, foldl, foldr, head, init, last, length)
+      #
+      # Default: after_alias
+      list_align: after_alias
+
+      # Right-pad the module names to align imports in a group:
+      #
+      # - true: a little more readable
+      #
+      #   > import qualified Data.List       as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # - false: diff-safe
+      #
+      #   > import qualified Data.List as List (concat, foldl, foldr, init,
+      #   >                                     last, length)
+      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
+      #   >                                           init, last, length)
+      #
+      # Default: true
+      pad_module_names: true
+
+      # Long list align style takes effect when import is too long. This is
+      # determined by 'columns' setting.
+      #
+      # - inline: This option will put as much specs on same line as possible.
+      #
+      # - new_line: Import list will start on new line.
+      #
+      # - new_line_multiline: Import list will start on new line when it's
+      #   short enough to fit to single line. Otherwise it'll be multiline.
+      #
+      # - multiline: One line per import list entry.
+      #   Type with constructor list acts like single import.
+      #
+      #   > import qualified Data.Map as M
+      #   >     ( empty
+      #   >     , singleton
+      #   >     , ...
+      #   >     , delete
+      #   >     )
+      #
+      # Default: inline
+      long_list_align: inline
+
+      # Align empty list (importing instances)
+      #
+      # Empty list align has following options
+      #
+      # - inherit: inherit list_align setting
+      #
+      # - right_after: () is right after the module name:
+      #
+      #   > import Vector.Instances ()
+      #
+      # Default: inherit
+      empty_list_align: inherit
+
+      # List padding determines indentation of import list on lines after import.
+      # This option affects 'long_list_align'.
+      #
+      # - <integer>: constant value
+      #
+      # - module_name: align under start of module name.
+      #   Useful for 'file' and 'group' align settings.
+      list_padding: 4
+
+      # Separate lists option affects formatting of import list for type
+      # or class. The only difference is single space between type and list
+      # of constructors, selectors and class functions.
+      #
+      # - true: There is single space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
+      #
+      # - false: There is no space between Foldable type and list of it's
+      #   functions.
+      #
+      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
+      #
+      # Default: true
+      separate_lists: true
+
+      # Space surround option affects formatting of import lists on a single
+      # line. The only difference is single space after the initial
+      # parenthesis and a single space before the terminal parenthesis.
+      #
+      # - true: There is single space associated with the enclosing
+      #   parenthesis.
+      #
+      #   > import Data.Foo ( foo )
+      #
+      # - false: There is no space associated with the enclosing parenthesis
+      #
+      #   > import Data.Foo (foo)
+      #
+      # Default: false
+      space_surround: false
+
+  # Language pragmas
+  - language_pragmas:
+      # We can generate different styles of language pragma lists.
+      #
+      # - vertical: Vertical-spaced language pragmas, one per line.
+      #
+      # - compact: A more compact style.
+      #
+      # - compact_line: Similar to compact, but wrap each line with
+      #   `{-#LANGUAGE #-}'.
+      #
+      # Default: vertical.
+      style: vertical
+
+      # Align affects alignment of closing pragma brackets.
+      #
+      # - true: Brackets are aligned in same column.
+      #
+      # - false: Brackets are not aligned together. There is only one space
+      #   between actual import and closing bracket.
+      #
+      # Default: true
+      align: true
+
+      # stylish-haskell can detect redundancy of some language pragmas. If this
+      # is set to true, it will remove those redundant pragmas. Default: true.
+      remove_redundant: true
+
+  # Replace tabs by spaces.
+  - tabs:
+     spaces: 8
+
+  # Remove trailing whitespace
+  - trailing_whitespace: {}
+
+columns: 80
+newline: lf
+
+language_extensions:
+   - UnicodeSyntax
+   - OverloadedStrings

master-plan.cabal

@@ -2,9 +2,13 @@ name:                master-plan
 version:             0.1.0.0
 synopsis:            Text based project management tool
 -- description:
-homepage:            https://github.com/rsetti/master-plan#readme
+homepage:            https://github.com/rodrigosetti/master-plan
+bug-reports:         https://github.com/rodrigosetti/master-plan/issues
 author:              Rodrigo Setti
 maintainer:          rodrigosetti@gmail.com
+stability:           alpha
+license:             MIT
+license-file:        LICENSE
 copyright:           2017 Rodrigo Setti. All rights reserved
 category:            Tools
 build-type:          Simple
@@ -27,6 +31,7 @@ library
     default-language:    Haskell2010
     ghc-options:         -Wall
     default-extensions:  OverloadedStrings
+                       , UnicodeSyntax
     build-depends:       base
                        , megaparsec
                        , containers

src/MasterPlan/Data.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE UnicodeSyntax #-}
 module MasterPlan.Data where
 
 import           Data.Foldable      (asum)
@@ -14,18 +15,10 @@ data Status = Ready | Blocked | InProgress | Done | Cancelled
           deriving (Eq, Show)
 
 -- |Structure of a project expression
-data Project = SumProj {
-                  subprojects :: NE.NonEmpty Project
-               } |
-               ProductProj {
-                  subprojects :: NE.NonEmpty Project
-               } |
-               SequenceProj {
-                  subprojects :: NE.NonEmpty Project
-               } |
-               RefProj {
-                  name :: String
-               }
+data Project = SumProj { subprojects :: NE.NonEmpty Project } |
+               ProductProj { subprojects :: NE.NonEmpty Project } |
+               SequenceProj { subprojects :: NE.NonEmpty Project } |
+               RefProj { name :: String }
                 deriving (Eq, Show)
 
 -- |A binding of a name can refer to an expression. If there are no
@@ -54,35 +47,35 @@ data ProjectProperties = ProjectProperties { title       :: String
 newtype ProjectSystem = ProjectSystem { bindings :: M.Map String ProjectBinding }
                           deriving (Eq, Show)
 
-defaultProjectProps :: ProjectProperties
+defaultProjectProps ∷ ProjectProperties
 defaultProjectProps = ProjectProperties { title = "root"
                                         , description = Nothing
                                         , url = Nothing
                                         , owner = Nothing }
 
-isOpen :: ProjectSystem -> Project -> Bool
+isOpen ∷ ProjectSystem → Project → Bool
 isOpen sys p = status sys p `elem` [InProgress, Ready, Blocked]
 
-isClosed :: ProjectSystem -> Project -> Bool
+isClosed ∷ ProjectSystem → Project → Bool
 isClosed sys p = not $ isOpen sys p
 
 -- | Expected cost
-cost :: ProjectSystem -> Project -> Cost
+cost ∷ ProjectSystem → Project → Cost
 cost sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just TaskProj { reportedCost=c }    -> c
     Just ExpressionProj { expression=p} -> cost sys p -- TODO: avoid cyclic
     Nothing                             -> 0 -- should not happen
-cost sys SequenceProj { subprojects=ps } = costConjunction sys $ NE.dropWhile (isClosed sys) ps
-cost sys ProductProj { subprojects=ps } = costConjunction sys $ NE.filter (isOpen sys) ps
-cost sys SumProj { subprojects=s } =
+cost sys (SequenceProj ps) = costConjunction sys $ NE.dropWhile (isClosed sys) ps
+cost sys (ProductProj ps) = costConjunction sys $ NE.filter (isOpen sys) ps
+cost sys (SumProj ps) =
    sum $ map (\x -> (1 - snd x) * fst x) $ zip costs accTrusts
  where
    accTrusts = scanl (\a b -> a + b*(1-a)) 0 $ map (trust sys) opens
    costs = map (cost sys) opens
-   opens = NE.filter (isOpen sys) s
+   opens = NE.filter (isOpen sys) ps
 
-costConjunction :: ProjectSystem -> [Project] -> Cost
+costConjunction ∷ ProjectSystem → [Project] → Cost
 costConjunction sys ps =
    sum $ zipWith (*) costs accTrusts
   where
@@ -90,57 +83,57 @@ costConjunction sys ps =
     accTrusts = map product $ inits $ map (trust sys) ps
 
 -- | Expected trust probability
-trust :: ProjectSystem -> Project -> Trust
+trust ∷ ProjectSystem → Project → Trust
 trust sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just TaskProj { reportedTrust=t }   -> t
     Just ExpressionProj { expression=p} -> trust sys p -- TODO: avoid cyclic
     Nothing                             -> 0 -- should not happen
-trust sys SequenceProj { subprojects=ps } = trustConjunction sys $ NE.dropWhile (isClosed sys) ps
-trust sys ProductProj { subprojects=ps } = trustConjunction sys $ NE.filter (isOpen sys) ps
-trust sys SumProj { subprojects=s } =
+trust sys (SequenceProj ps) = trustConjunction sys $ NE.dropWhile (isClosed sys) ps
+trust sys (ProductProj ps) = trustConjunction sys $ NE.filter (isOpen sys) ps
+trust sys (SumProj ps) =
   if null opens then 1 else accTrusts
  where
   accTrusts = foldl (\a b -> a + b*(1-a)) 0 $ map (trust sys) opens
-  opens = NE.filter (isOpen sys) s
+  opens = NE.filter (isOpen sys) ps
 
-trustConjunction :: ProjectSystem -> [Project] -> Trust
+trustConjunction ∷ ProjectSystem → [Project] → Trust
 trustConjunction sys ps = product $ map (trust sys) ps
 
-progress ::ProjectSystem -> Project -> Progress
+progress ∷ProjectSystem → Project → Progress
 progress sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just TaskProj { reportedStatus=Done } -> 1
     Just TaskProj { reportedProgress=p }  -> p
     Just ExpressionProj { expression=p}   -> progress sys p -- TODO: avoid cyclic
     Nothing                               -> 0 -- should not happen
-progress sys SequenceProj { subprojects=s }   = progressConjunction sys s
-progress sys ProductProj { subprojects=s }    = progressConjunction sys s
-progress sys SumProj { subprojects=s }        = maximum $ NE.map (progress sys) s
+progress sys (SequenceProj ps)   = progressConjunction sys ps
+progress sys (ProductProj ps)    = progressConjunction sys ps
+progress sys (SumProj ps)        = maximum $ NE.map (progress sys) ps
 
-progressConjunction :: ProjectSystem -> NE.NonEmpty Project -> Progress
+progressConjunction ∷ ProjectSystem → NE.NonEmpty Project → Progress
 progressConjunction sys ps =
    let opens = NE.filter (isOpen sys) ps
     in if null opens
       then 1
       else sum (map (progress sys) opens) / fromIntegral (length opens)
 
-status :: ProjectSystem -> Project -> Status
+status ∷ ProjectSystem → Project → Status
 status sys (RefProj n) =
   case M.lookup n (bindings sys) of
     Just TaskProj { reportedProgress=p, reportedStatus=s }  -> if p>=1 then Done else s
     Just ExpressionProj { expression=p}  -> status sys p -- TODO: avoid cyclic
     Nothing                                        -> Cancelled -- should not happen
-status sys SequenceProj { subprojects=s } =
-  let rest = NE.dropWhile (isClosed sys) s
+status sys (SequenceProj ps) =
+  let rest = NE.dropWhile (isClosed sys) ps
   in case rest of (p : _) -> status sys p
                   []      -> Done
-status sys ProductProj { subprojects=ps } =
+status sys (ProductProj ps) =
   statusPriority [InProgress, Ready, Blocked, Cancelled, Done] sys ps
-status sys SumProj { subprojects=ps } =
+status sys (SumProj ps) =
   statusPriority [Done, InProgress, Ready, Blocked, Cancelled] sys ps
 
-statusPriority :: [Status] -> ProjectSystem -> NE.NonEmpty Project -> Status
+statusPriority ∷ [Status] → ProjectSystem → NE.NonEmpty Project → Status
 statusPriority priority sys ps =
   let ss = NE.map (status sys) ps
    in fromMaybe Done $ asum $ map (\x -> find (x ==) ss) priority

test/MasterPlan/DataSpec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE UnicodeSyntax #-}
 module MasterPlan.DataSpec where
 
 import           Data.Bool           (bool)
@@ -8,6 +9,7 @@ import           Test.QuickCheck     hiding (sample)
 
 import           Control.Applicative ((<$>), (<*>))
 import           Control.Monad.State
+import           Data.List           (nub)
 import qualified Data.List.NonEmpty  as NE
 import           System.Random
 
@@ -28,12 +30,15 @@ instance Arbitrary ProjectProperties where
 
 instance Arbitrary Status where
 
-  arbitrary = oneof [ pure Ready, pure Blocked, pure InProgress, pure Done, pure Cancelled ]
+  arbitrary = elements [ Ready, Blocked, InProgress, Done, Cancelled ]
 
-testingKeys :: [String]
+  shrink Done = []
+  shrink _    = [Done]
+
+testingKeys ∷ [String]
 testingKeys = ["a","b","c","d"]
 
-rootKey :: String
+rootKey ∷ String
 rootKey = "root"
 
 instance Arbitrary ProjectSystem where
@@ -41,13 +46,12 @@ instance Arbitrary ProjectSystem where
   arbitrary = do bs <- replicateM (length testingKeys) arbitrary
                  let arbitraryExpr = ExpressionProj <$> arbitrary <*> arbitrary
                  rootB <- frequency [ (1, arbitrary), (10, arbitraryExpr) ]
-                 let bindings = M.insert rootKey rootB $ M.fromList $ zip testingKeys bs
-                 pure $ ProjectSystem bindings
+                 pure $ ProjectSystem $ M.insert rootKey rootB $ M.fromList $ zip testingKeys bs
 
   shrink (ProjectSystem bs) =
       map ProjectSystem $ concatMap shrinkOne testingKeys
     where
-      shrinkOne :: String -> [M.Map String ProjectBinding]
+      shrinkOne ∷ String → [M.Map String ProjectBinding]
       shrinkOne k = case M.lookup k bs of
         Nothing -> []
         Just b  -> map (\s -> M.adjust (const s) k bs) $ shrink b
@@ -64,6 +68,12 @@ instance Arbitrary ProjectBinding where
                  <*> arbitrary
                  <*> unitGen
 
+  shrink b = nub [ b { reportedCost=0 }
+                 , b { reportedCost=1 }
+                 , b { reportedTrust=0 }
+                 , b { reportedTrust=1 }
+                 , b { reportedStatus=Done } ]
+
 instance Arbitrary Project where
 
   arbitrary =
@@ -78,11 +88,11 @@ instance Arbitrary Project where
   shrink (SequenceProj ps) = map SequenceProj (shrink ps) ++ NE.toList ps
   shrink (RefProj _)       = []
 
-average :: RandomGen g => State g Float -> Int -> State g Float
+average ∷ RandomGen g ⇒ State g Float → Int → State g Float
 average sample n = do total <- replicateM n sample
                       pure $ sum total / fromIntegral n
 
-simulate :: RandomGen g => ProjectSystem -> Project -> State g (Bool, Cost)
+simulate ∷ RandomGen g ⇒ ProjectSystem → Project → State g (Bool, Cost)
 simulate sys (RefProj n) =
    case M.lookup n (bindings sys) of
      Just TaskProj { reportedTrust=t, reportedCost=c }    ->
@@ -97,7 +107,7 @@ simulate sys SumProj { subprojects=ps }        =
   if null opens then pure (True, 0) else simulate' opens
  where
    opens = NE.filter (isOpen sys) ps
-   simulate' :: RandomGen g => [Project] -> State g (Bool, Cost)
+   simulate' ∷ RandomGen g ⇒ [Project] → State g (Bool, Cost)
    simulate' [] = pure (False, 0)
    simulate' (p:rest) = do (success, c) <- simulate sys p
                            if success then
@@ -106,7 +116,7 @@ simulate sys SumProj { subprojects=ps }        =
                              do (success', c') <- simulate' rest
                                 pure (success', c + c')
 
-simulateConjunction :: RandomGen g => ProjectSystem -> [Project] -> State g (Bool, Cost)
+simulateConjunction ∷ RandomGen g ⇒ ProjectSystem → [Project] → State g (Bool, Cost)
 simulateConjunction _ []       = pure (True, 0)
 simulateConjunction sys (p:rest) = do (success, c) <- simulate sys p
                                       if success then do
@@ -115,27 +125,27 @@ simulateConjunction sys (p:rest) = do (success, c) <- simulate sys p
                                       else
                                         pure (False, c)
 
-monteCarloTrusteAndCost :: RandomGen g => Int -> ProjectSystem -> Project -> State g (Trust, Cost)
+monteCarloTrusteAndCost ∷ RandomGen g ⇒ Int → ProjectSystem → Project → State g (Trust, Cost)
 monteCarloTrusteAndCost n sys p = do results <- replicateM n $ simulate sys p
                                      let trusts = map (bool 0 1 . fst) results
                                      let costs = map snd results
                                      pure (sum trusts / fromIntegral n,
                                            sum costs / fromIntegral n)
 
-aproximatelyEqual :: Float -> Float -> Property
+aproximatelyEqual ∷ Float → Float → Property
 aproximatelyEqual x y =
    counterexample (show x ++ " /= " ++ show y) (abs (x - y) <= epislon)
   where
     epislon = 0.05
 
-spec :: Spec
+spec ∷ Spec
 spec = do
   describe "estimations" $ do
 
     let g = mkStdGen 837183
 
     it "monte-carlo and analytical implementations should agree on cost" $ do
-      let propertyMCAndAnalyticalEq :: ProjectSystem -> Property
+      let propertyMCAndAnalyticalEq ∷ ProjectSystem → Property
           propertyMCAndAnalyticalEq sys =
             cost' `aproximatelyEqual` cost sys p
            where
@@ -145,7 +155,7 @@ spec = do
       property propertyMCAndAnalyticalEq
 
     it "monte-carlo and analytical implementations should agree on trust" $ do
-        let propertyMCAndAnalyticalEq :: ProjectSystem -> Property
+        let propertyMCAndAnalyticalEq ∷ ProjectSystem → Property
             propertyMCAndAnalyticalEq sys =
               trust' `aproximatelyEqual` trust sys p
              where