lcc/Hcompta/LCC/Chart/Test.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3 {-# LANGUAGE TupleSections #-}
   4
   5 module Chart.Test where
   6
   7 import Test.Tasty
   8 import Test.Tasty.HUnit
   9
  10 import Control.Applicative (Applicative(..))
  11 import Control.Monad.IO.Class (MonadIO(..))
  12 import Control.Monad (join, (>=>))
  13 import Data.Function (($), (.), const, id)
  14 import Data.Functor ((<$>))
  15 import Data.Bool
  16 import Data.Functor.Identity (Identity(..))
  17 import Data.Text (Text)
  18 import qualified Data.List as List
  19 import Data.List.NonEmpty (NonEmpty)
  20 import qualified Data.List.NonEmpty as NonEmpty
  21 import qualified Data.Text as Text
  22 import qualified Data.Text.IO as Text.IO
  23 import qualified Data.NonNull as NonNull
  24 import Data.Maybe (isJust)
  25 import qualified Data.Strict.Maybe as Strict
  26 import qualified Data.Map.Strict as Map
  27 import qualified Data.TreeMap.Strict as TreeMap
  28 import Data.TreeMap.Strict.Zipper
  29 import Data.Tuple (fst, snd)
  30 import qualified Hcompta.LCC.Lib.Parsec as R
  31 import qualified Text.Parsec as R (eof)
  32 import qualified Text.Parsec.Combinator.CorrectSourcePosWithTab as R
  33 import qualified Text.Parsec.Error.Custom as R
  34 import qualified Text.Parsec.Pos as R
  35 import System.IO (IO, FilePath)
  36 import qualified System.Directory as IO
  37 import qualified System.IO.Memoize as IO
  38 import Prelude (error)
  39 import Text.Show (show)
  40 import Data.Either (either)
  41 import System.FilePath.Posix ((</>))
  42
  43 import qualified Hcompta as H
  44 import qualified Hcompta.LCC as LCC
  45
  46 chart_from_text :: Text -> LCC.Chart
  47 chart_from_text txt =
  48         let context_read :: LCC.Context_Read () () =
  49                 LCC.context_read (const ()) LCC.journal in
  50         runIdentity $
  51                 (either (error . show) id <$>) <$>
  52                 ((LCC.journal_chart . LCC.context_read_journal . snd <$>) <$>) $
  53                 R.runParserTWithError
  54                  (R.and_state (LCC.read_chart <* R.eof))
  55                  context_read "" txt
  56
  57 chart_from_file :: FilePath -> IO LCC.Chart
  58 chart_from_file file = do
  59         cwd <- IO.getCurrentDirectory
  60         chart_from_text <$> Text.IO.readFile (cwd </> file)
  61
  62 chart_00 :: (FilePath, IO LCC.Chart)
  63 chart_00 = (file,) $ join $ IO.once $ chart_from_file file
  64         where file = "Hcompta/LCC/Chart/chart.00.lcc"
  65 chart_01 :: (FilePath, IO LCC.Chart)
  66 chart_01 = (file,) $ join $ IO.once $ chart_from_file file
  67         where file = "Hcompta/LCC/Chart/chart.01.lcc"
  68
  69 tag_path :: [Text] -> LCC.Tag_Path
  70 tag_path p = LCC.Tag_Path $ NonEmpty.fromList (LCC.Name <$> p)
  71
  72 nonempty :: [Text] -> NonEmpty LCC.Name
  73 nonempty p = NonEmpty.fromList (LCC.Name <$> p)
  74
  75 tests :: TestTree
  76 tests = testGroup "Chart"
  77  [ testGroup "chart_axis_child" $
  78         let (==>) (file, input) expected =
  79                 testCase file $ do
  80                         chart <- input
  81                         let sel = zipper_child
  82                         let res = sel $ LCC.zipper_chart chart
  83                         let path = (LCC.unName <$>) . path_of_zipper <$> res
  84                         path @?= expected
  85         in
  86          [ chart_00 ==>
  87                  [ ["1.Capital"]
  88                  , ["2.Immobilisation"]
  89                  , ["3.Stock"]
  90                  , ["4.Tiers"]
  91                  , ["5.Finance"]
  92                  , ["6.Charge"]
  93                  , ["7.Produit"]
  94                  ]
  95          ]
  96  , testGroup "chart_axis_descendant" $
  97         let (==>) (file, input) expected =
  98                 testCase file $ do
  99                         chart <- input
 100                         let sel = zipper_descendant
 101                         let res = sel $ LCC.zipper_chart chart
 102                         let path = (LCC.unName <$>) . path_of_zipper <$> res
 103                         path @?= expected
 104         in
 105          [ chart_00 ==>
 106                  [ ["1.Capital"]
 107                  , ["2.Immobilisation"]
 108                  , ["3.Stock"]
 109                  , ["4.Tiers"]
 110                  , ["4.Tiers", "0.Fournisseur"]
 111                  , ["4.Tiers", "0.Fournisseur", "9.Débiteur"]
 112                  , ["4.Tiers", "1.Client"]
 113                  , ["4.Tiers", "2.Personnel"]
 114                  , ["4.Tiers", "3.Sécu"]
 115                  , ["4.Tiers", "4.État"]
 116                  , ["5.Finance"]
 117                  , ["5.Finance", "1.Établissement"]
 118                  , ["5.Finance", "1.Établissement", "2.Banque"]
 119                  , ["5.Finance", "3.Caisse"]
 120                  , ["6.Charge"]
 121                  , ["7.Produit"]
 122                  ]
 123          ]
 124  , testGroup "zipper_account_tags" $
 125         let (==>) (file, input) expected =
 126                 testCase file $ do
 127                         chart <- input
 128                         let sel =
 129                          -- //*[...[#Bilan][0][#Bilan:Actif]]
 130                                 zipper_descendant
 131                                 `zipper_filter` not . zipper_null
 132                                  (zipper_ancestor_or_self
 133                                         `zipper_filter` not . zipper_null
 134                                          (zipper_child_lookup $ LCC.Name "Bilan")
 135                                          . LCC.zipper_accounts_tags
 136                                         `zipper_at` 0
 137                                         `zipper_filter` not . zipper_null
 138                                          (zipper_descendant_lookup $ nonempty ["Bilan", "Actif"])
 139                                          . LCC.zipper_accounts_tags)
 140                         let res = sel $ zipper $ LCC.chart_accounts chart
 141                         let path = (LCC.unName <$>) . path_of_zipper <$> res
 142                         path @?= expected
 143         in
 144          [ chart_00 ==>
 145                  [ ["2.Immobilisation"]
 146                  , ["4.Tiers","0.Fournisseur","9.Débiteur"]
 147                  , ["4.Tiers","1.Client"]
 148                  , ["4.Tiers","3.Sécu"]
 149                  ]
 150          ]
 151  ]